Excel 单元格变化时自动记录日期和时间 VBA

Question

我正在使用以下 VBA 代码在我编辑或更改单元格时自动为日期添加时间戳。 但是，它工作得很好，每当我删除一行时，它都会导致其正下方的单元格刷新其时间戳，这非常烦人，并导致我隐藏不需要的行而不是删除它们，如果您能帮助我通过更改解决此问题，我将不胜感激在 VBA。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("B:B"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
    Application.EnableEvents = False
    For Each Rng In WorkRng
        If Not VBA.IsEmpty(Rng.Value) Then
            Rng.Offset(0, xOffsetColumn).Value = Now
            Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
        Else
            Rng.Offset(0, xOffsetColumn).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If
End Sub

Answer 1

您可以忽略涉及整行或多行的更改：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim WorkRng As Range, c As Range
    Dim Rng As Range
    Dim xOffsetColumn As Integer
    
    'whole row(s) changed - do not process
    If Target.Columns.Count = Me.Columns.Count Then Exit Sub
    
    Set WorkRng = Intersect(Application.ActiveSheet.Range("B:B"), Target)
    xOffsetColumn = 1
    If Not WorkRng Is Nothing Then
        Application.EnableEvents = False
        For Each Rng In WorkRng
            Set c = Rng.Offset(0, xOffsetColumn) '****
            If Not VBA.IsEmpty(Rng.Value) Then
                c.Value = Now
                c.NumberFormat = "dd-mm-yyyy, hh:mm:ss"
            Else
                c.ClearContents
            End If
        Next
        Application.EnableEvents = True
    End If
End Sub