Есть ли способ поставить метку времени на основе активности другой клетки?

Question

Я сейчас создаю систему показателей для своей команды. Я дал указание пользователям вставлять свои имена, используя раскрывающийся список, в который входит их имя, или вводить их имя в столбце G при просмотре элемента.

 Option Explicit

 Private Sub Worksheet_Change(ByVal Target As Range)
 Dim rng1 As Range
 Set rng1 = Intersect(Range("G:G"), Target)
 If rng1 Is Nothing Then Exit Sub
 Application.EnableEvents = False
 rng1.Offset(0, 1).Value = Now() & " - " & Environ("username")
 Application.EnableEvents = True
 If Intersect(Range("G:G"), Target) = "" Then rng1.Offset(0, 1).ClearContents
 End Sub

На данный момент: Временные метки листа в той же строке в столбце H всех отдельных действий в столбце G (это включает удаление имен и изменение имен). Если пользователи заполняются автоматически во время выполнения, появится сообщение «13».

Что я хотел бы сделать: - Отметка времени в столбце H, когда пользователь заполняет свое имя в столбце G - Если пользователь автоматически заполняет, тогда в этой же строке в столбце H будет сгенерирована временная метка. - Если очистить ячейки в столбце G, отметка времени также будет очищена.

Answer 1

Только для объяснения: Ваше несоответствие типов (ошибка времени выполнения 13) будет сгенерировано, когда вы назначаете строку (вашу временную метку) диапазону, который состоит более чем из одной ячейки, или когда вы запрашиваете Excel сравнить многоклеточный диапазон в строку (в вашем случае ""). Когда пользователь заполняется автоматически, выбирается более одной ячейки, и вы сталкиваетесь с ошибкой. С данным кодом SJR вы сохранитесь.

Answer 2

Не уверен, что вы подразумеваете под автозаполнением, но если изменяется больше чем ячейка, вы можете перебрать 'Target', чтобы избежать ошибки.

Затем просто проверьте, пуста ли измененная ячейка, если это так, очистите H.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng1 As Range, r As Range

Set rng1 = Intersect(Range("G:G"), Target)

If rng1 Is Nothing Then Exit Sub

Application.EnableEvents = False

For Each r In rng1
    If r.Value = vbNullString Then
        r.Offset(0, 1).ClearContents
    Else
        r.Offset(0, 1).Value = Now() & " - " & Environ("username")
    End If
    'for fans of brevity, replace the If clause with below
    'r.Offset(0, 1).Value = IIf(r.Value = vbNullString, vbNullString, Now() & " - " & Environ("username"))
Next r

Application.EnableEvents = True

End Sub