excel - 在 Excel 文件中自动填写日期

Question

有人可以帮我处理这段代码吗？如果我对 I 进行任何更改，它将在 H 中插入当前日期。
我的问题是，例如，如果我在 I1 中填写一些内容，然后我向下拖动以一次复制多个单元格，这将不起作用。例如，如果我在每个单元格(I2，I3 ETC)中一次从 I1 复制值，它将起作用。

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Updated by Extendoffice 2017/10/12
    Dim xRg As Range, xCell As Range
    On Error Resume Next
    If (Target.Count = 1) Then
        If (Not Application.Intersect(Target, Me.Range("I:I")) Is Nothing) Then _
            Target.Offset(0, -1) = Date
        Application.EnableEvents = False
        Set xRg = Application.Intersect(Target.Dependents, Me.Range("I:I10"))
        If (Not xRg Is Nothing) Then
            For Each xCell In xRg
                xCell.Offset(0, -1) = Date
            Next
        End If
        Application.EnableEvents = True
    End If
End Sub

谢谢 !

Answer 1

避免不必要地使用 On Error Resume Next .优雅地处理错误。我推荐阅读THIS使用 Worksheet_Change 时有一次
你也有If (Target.Count = 1) Then因为你的代码没有执行。拖动时，计数会增加。
这是你正在尝试的吗？

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Whoa
    Dim aCell As Range
    
    Application.EnableEvents = False
    
    If Not Intersect(Target, Range("I:I")) Is Nothing Then
        For Each aCell In Target
            '~~> Additional blank check for I. So that the date
            '~~> is not inserted if the value is deleted. Remove this
            '~~> if you want the date to be inserted even when the value is deleted
            If Len(Trim(aCell.Value)) <> 0 Then
                Range("H" & aCell.Row).Value = Date
            Else
                'Remove Date?
            End If
        Next aCell
    End If
    
Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

在行动: