一个单元格中的值更改时的多个时间戳

Question

我正在尝试记录在A列的一个单元格中进行的多项更改。在我的示例中，我有一个用户可以在A5列中输入日期和时间。稍后，用户可能会更改此相同单元格中的值（A5）。这种变化最多可能发生5次。如何从AH栏开始记录所有这5项更改的日期和时间。

因此，A5中的第一个更改应记录在AH5列中，A5中的第二个更改应记录在AI5列中，依此类推。

我发现了多个宏，但它们只是每次都在同一个单元格中更改日期和时间的时间戳。

Answer 1

将以下代码放入目标工作表模块：

Private Sub Worksheet_Change(ByVal Target As Range)
    Static RecCell As Range
    If Target.Address = "$A$5" Then
        Select Case True
        Case RecCell Is Nothing
            Set RecCell = Target.Parent.Range("AH5")
            RecCell.Value = Target.Value
        Case RecCell.Column < Target.Parent.Range("AL5").Column
            Set RecCell = RecCell.Offset(0, 1)
            RecCell.Value = Target.Value
        End Select
    End If
End Sub

然后，已打开的工作簿中的第一个A5更改将保存到AH5，接下来的四个更改为AI5:AL5，将忽略进一步的更改。

的更新

以下是符合您上一个要求的代码。为了使其足够灵活，我已经添加了一些额外的检查，禁止记录该值，如果它不是以前记录的日期或相同的。您可以通过删除相应的Case语句行轻松更改这些限制 - 请参阅我的评论。如果e，它还处理所有已更改的单元格。 G。已复制的单元格已粘贴到多个选定的单元格中。

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Add reference: Menu - Tools - References - Microsoft Scripting Runtime
    Static RecList As New Dictionary ' dictionary stores a number of column last record have been made for each row
    Dim Cell As Range
    For Each Cell In Target ' loop through all cells that have been changed
        With Cell
            Select Case True
            Case .Column <> 1 ' exit if column is not A
                Exit Sub
            Case .Row < 5 Or .Row > 205 ' exit if row is out of target range
                Exit Sub
            Case Not IsDate(.Value) ' exit if changed value hasn't got a date format
                Exit Sub
            Case Not RecList.Exists(.Row) ' first change in this row
                RecList(.Row) = Range("AH:AH").Column ' start recording from AH, proceed with value assigning
            Case .Parent.Cells(.Row, RecList(.Row)) = .Value ' exit if current entered value is the same as the previous
                Exit Sub
            Case RecList(.Row) < Range("AL:AL").Column ' the previous populated column is less than AL
                Set RecList(.Row) = RecList(.Row) + 1 ' continue recording, shift right, proceed with value assigning
            Case Else ' exit if the previous populated column is AL
                Exit Sub
            End Select
            .Parent.Cells(.Row, RecList(.Row)) = .Value ' assign the value from changed cell
        End With
    Next
End Sub