Две временные метки работают одновременно?

Question

Мне нужна помощь в написании кода, который позволит использовать метку даты / времени в столбце H, если в I введено какое-либо значение. Прямо сейчас приведенный ниже код позволяет использовать метку времени в G, когда значение вводится в столбце B. Что мне нужно сделать?

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim rCell As Range
    Dim rChange As Range

    On Error GoTo ErrHandler
    Set rChange = Intersect(Target, Range("B:B"))
    If Not rChange Is Nothing Then
        Application.EnableEvents = False
        For Each rCell In rChange
            If rCell > "" Then
                With rCell.Offset(0, 5)
                    .Value = Now
                    .NumberFormat = "mm-dd-yy h:mm AM/PM"

                End With
            Else
                rCell.Offset(0, 5).Clear
            End If
        Next
    End If

ExitHandler:
    Set rCell = Nothing
    Set rChange = Nothing
    Application.EnableEvents = True
    Exit Sub
ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

Answer 1

Вы можете добавить ElseIf для второго диапазона или включите I:I в первичную проверку на пересечение и решите, где заполнить отметку времени, в зависимости от того, было ли это B:B или I:I, которые получили добавление / удаление / модификацию. Я продемонстрирую последнее.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim rCell As Range
    Dim rChange As Range

    On Error GoTo ErrHandler
    Set rChange = Intersect(Target, Range("B:B, I:I")) '<- note change
    If Not rChange Is Nothing Then
        Application.EnableEvents = False
        For Each rCell In rChange
            If rCell > "" Then
                With rCell.Offset(0, 5 + (rCell.Column = 9) * 6) '<- note change
                    .Value = Now
                    .NumberFormat = "mm-dd-yy h:mm AM/PM"

                End With
            Else
                rCell.Offset(0, 5 + (rCell.Column = 9) * 6).Clear '<- note change
            End If
        Next
    End If

ExitHandler:
    Set rCell = Nothing
    Set rChange = Nothing
    Application.EnableEvents = True
    Exit Sub
ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

Я добавил I:I к проверке на пересечение и использовал VBA True = (-1), чтобы настроить, какой столбец получает метку времени.