Показать метку времени при изменении ячейки

Question

Мне нужно знать, как отображать метку времени в ячейке в столбце D, когда ячейка изменяется в той же строке в столбце B. Я отредактировал этот снимок экрана в краске, чтобы легче понять, что я имею в виду:Изображение

У меня есть скрипт VBA, который проверяет другой лист на значение, которое он вводит в столбце B. Это происходит с событием select Worksheet_SelectionChange, поэтому я не могу просто добавить:

Range("D3").Value = Now()

Или что-то подобное, так как оно будет обновляться каждый раз, когда я выбираю что-то, и мне нужно, чтобы оно обновлялось только при изменении ячейки в столбце B. Значение в столбце B содержит только цифры 0, 1 или 2 между прочим

Answer 1

Этот код VBA сделает это:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim wk As Workbook
Set wk = ThisWorkbook
Dim ws As Worksheet
Set ws = ActiveSheet
WatchedColumn = 2
BlockedRow = 1
TimestampColumn = 4
Crow = Target.Row
CColumn = Target.Column
If CColumn = WatchedColumn And Crow > BlockedRow Then
    Cells(Crow, TimestampColumn) = Now()
End If

End Sub

Вы должны скопировать код, перейти в View -> Macros в Excel, создать новый (любое имя допустимо) и в левом столбце дважды щелкнуть лист, где вы хотите его использовать (красный флажок на рисунке), и в с правой стороны вставьте код.

Этот макрос изменяет содержимое ячейки в столбце D всякий раз, когда происходит изменение в той же строке в столбце B. Переменная BlockedRow защищает первую строку, потому что она обычно имеет метки, если у вас более одной строки меток, изменив переменную на 2 или больше.

Если вам нужно изменить столбцы, внесите изменения в переменные WatchedColumn и TimestampColumn . (A = 1, B = 2, C = 3, D = 4, ... и т.д.).

Answer 2

Я знаю, что уже есть ответ, но этот VBA немного чище -

Private Sub worksheet_change(ByVal target As Range)
 If Not Intersect(target, Range("B:B")) Is Nothing Then
  target.Offset(0, 2) = Now()
 End If
End Sub

Чтобы откорректировать ваше другое требование, которого нет в вопросе, просто добавьте if -

Private Sub worksheet_change(ByVal target As Range)
    If Not Intersect(target, Range("B:B")) Is Nothing Then
        If target.Row > 1 Then
           target.Offset(0, 2) = Now()
        End If
    End If
End Sub