Автоматическое обновление метки времени в Excel - PullRequest
Новая
       9

Автоматическое обновление метки времени в Excel

0 голосов
/ 27 марта 2020

В настоящее время я работаю над листом, который должен автоматически вставлять текущую дату в ячейку, если другая ячейка = "Да"

В настоящее время у меня есть эта строка кода (которую я нашел в Интернете): 

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim cell As Range
    If Not Intersect(Target, Range("G:G")) Is Nothing Then
        Application.EnableEvents = False
        For Each cell In Target
            cell.Offset(0, 4).Value = Now
            cell.Offset(0, 4).NumberFormat = "dd/mm/yyyy"
        Next cell
    End If
    Application.EnableEvents = True
End Sub

Проблема в том, что обновленная ячейка в строке K обновляется каждый раз, когда ячейка изменяется, и она должна обновляться только тогда, когда ячейка в строке G = "Да"

Я ценю помощь:)

Ответы [ 2 ]

1 голос
/ 27 марта 2020

Ваша базовая c проблема решается легко - просто добавьте If, чтобы проверить содержимое ячейки: 

    For Each cell In Target
        If UCase(cell.Value2) = "YES" Then
            cell.Offset(0, 4).Value = Now
            cell.Offset(0, 4).NumberFormat = "dd/mm/yyyy"
        Next cell
   Next cell

Однако ваша проверка для столбца 'G' некорректна. Target содержит все ячейки, которые в данный момент изменены. Если пользователь введет что-то в ячейку, Target будет содержать именно эту ячейку. Однако, если данные, например, вставлены в этот лист, Target будет содержать все ячейки, в которые вставляются данные.

Теперь Intersect проверяет, имеют ли два диапазона общие ячейки. Ваше заявление If Not Intersect(Target, Range("G:G")) Is Nothing проверит, находится ли любая измененных ячеек в столбце G, и если да, оно запишет дату в ячейку, которая на 4 колонки справа. В случае, если пользователь вводит что-то в ячейку столбца G, это нормально. Но если он вставит что-то в, скажем, ячейки столбцов F, G, H, код будет работать для всех трех ячеек. Таким образом, вы должны проверить каждую ячейку отдельно. 

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo change_exit    ' Ensure that events are re-enabled in case of error
    Application.EnableEvents = False
    Dim cell As Range
    For Each cell In Intersect(Target, Range("G:G"))
        If UCase(cell.Value2) = "YES" Then
            cell.Offset(0, 4).Value = Now
            cell.Offset(0, 4).NumberFormat = "dd/mm/yyyy"
        end if
    Next cell
change_exit:
    Application.EnableEvents = True
End Sub

Обновление : изменен лог c, просто зацикливаясь на ячейках target, которые пересекаются со столбцом G - спасибо в BigBen за подсказку.

0 голосов
/ 27 марта 2020

Рассмотрим: 

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim cell As Range
    If Not Intersect(Target, Range("G:G")) Is Nothing Then
        Application.EnableEvents = False
        For Each cell In Target
            If cell.Value = "Yes" Then
                cell.Offset(0, 4).Value = Now
                cell.Offset(0, 4).NumberFormat = "dd/mm/yyyy"
            End If
        Next cell
    End If
    Application.EnableEvents = True
End Sub

Мы проверяем значение каждой записи!

...