Создать новую метку даты каждый раз, когда определенная ячейка изменяется? - PullRequest
0 голосов
/ 18 января 2019

У меня есть ячейка, в которой указано состояние проекта, и этот статус будет часто меняться.

Когда бы ни менялся статус, я бы хотел, чтобы в строке указывалось время, когда статус был изменен, и имя нового статуса.

У меня практически нет опыта работы с VBA, поэтому любая помощь будет принята с благодарностью.Пока у меня есть это:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Column = 4 And Target.Row = 4 Then

        Target.Offset(10, 3) = Format(Now(), "YYYY-MM-DD HH:MM:SS")

    End If

End Sub

Этот код успешно перечисляет время в ячейке G7 всякий раз, когда изменяется статус, содержащийся в ячейке D4, но он всегда заполняет одну и ту же ячейку, я хотел бы, чтобы каждое последующее изменение статуса отображалось в спискеотметка даты в ячейке G8, затем G9, затем G10 и т. д.

В нем также не указано, какая ячейка состояния D4 также изменилась, в идеале я хотел бы, чтобы это было указано в F7, затем в F8, затем в F9 и т. Д.

Ответы [ 2 ]

0 голосов
/ 18 января 2019

Пожалуйста, попробуйте это.

Private Sub Worksheet_Change(ByVal Target As Range)

    Const Tgt As String = "D4"              ' monitored cell
    Const FirstRecord As Long = 7           ' change as required
    Const Fmt As String = "yyyy-mm-dd hh:mm:ss"

    Dim Rl As Long                          ' last used row

    If Target.Address = Range(Tgt).Address Then
        Application.EnableEvents = False
        Rl = Application.WorksheetFunction.Max( _
             Cells(Rows.Count, "F").End(xlUp).Row + 1, FirstRecord)
        With Cells(Rl, "G")
            .Value = Now()
            .NumberFormat = Fmt
            Target.Copy Destination:=.Offset(0, -1)
        End With
        Application.EnableEvents = True
    End If
End Sub
0 голосов
/ 18 января 2019
  1. Если вас интересует только Worksheet_Change в ячейке D4, вы можете использовать метод Intersect, показанный ниже
  2. Чтобы запустить рабочий список, вам нужно определить, какая последняя использованная ячейка в Column G, и соответственно сместить

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("D4")) Is Nothing Then
        Dim LR As Long: LR = Range("G" & Rows.Count).End(xlUp).Offset(1).Row
        Target.Offset(LR - Target.Row, 3) = Format(Now(), "YYYY-MM-DD HH:MM:SS")
        Target.Offset(LR - Target.Row, 4) = Target
    End If

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...