一个单元格中的值更改时的多个时间戳 [英] Multiple timestamps when a value in one cell changes

问题描述

我试图记录在A列的一个单元格中进行的多项更改.在我的示例中，我有一个用户，它将在A5列中输入日期和时间.稍后，用户可能会更改同一单元格(A5)中的值.此更改最多可能发生5次.我如何从AH列开始记录所有5项更改的日期和时间.

I'm trying to record multiple changes that is made in one cell in column A. In my example I have a user that would enter the date and time in column A5. Later on the user might change the value in this same cell (A5). This change could happen up to 5 times. How do I record the date and time of all 5 these changes starting in column AH.

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

So the first change in A5 should be recorded in column AH5, the second change in A5 should be recorded in column AI5, and so on.

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

I found multiple macros but they only timestamp the date and time the change in the same cell every time.

推荐答案

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

Put the following code to your target worksheet module:

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.复制的单元格已粘贴到几个选定的单元格中.

Then the first A5 change in opened workbook will be saved to AH5, and the next four changes to AI5:AL5, further changes will be ignored.

UPDATE

Here is the code meeting your last requirements. To make it flexible enough I've added some extra checks which are forbidding to record the value, if it's not a date or the same as the previously recorded. You can easily change those limitations by deleting corresponding Case statement lines - see my comments. Also it processes all changed cells if e. g. a copied cell has been pasted to several selected cells.

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

这篇关于一个单元格中的值更改时的多个时间戳的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！