Excel VBA响应日期自动化代码求助：删除内容时未清除日期

原代码核心问题 #

• xRg变量未赋值，导致循环逻辑完全不执行
• 单元格空/非空的判断逻辑完全颠倒，和需求不符
• 未正确关联Target单元格与判断逻辑

修改后的完整代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim watchRng As Range
    Dim cell As Range
    
    ' 定义需要监控的列：U,W,Y,AA,AC,AE,AG,AI
    Set watchRng = Intersect(Target, Me.Range("U:U,W:W,Y:Y,AA:AA,AC:AC,AE:AE,AG:AG,AI:AI"))
    
    On Error GoTo ErrorHandler
    If Not watchRng Is Nothing Then
        Application.EnableEvents = False
        ' 遍历所有触发变更的单元格（支持批量修改）
        For Each cell In watchRng
            With cell.Offset(0, 1)
                If VBA.IsEmpty(cell.Value) Then
                    ' 单元格内容被删除，清除右侧日期
                    .ClearContents
                Else
                    ' 单元格有内容，且右侧无日期时才写入首次修改时间
                    If VBA.IsEmpty(.Value) Then
                        .Value = Now
                        ' 可选：设置日期格式
                        .NumberFormat = "yyyy-mm-dd hh:mm:ss"
                    End If
                End If
            End With
        Next cell
    End If

ErrorHandler:
    Application.EnableEvents = True
End Sub

代码关键说明 #

• 取消无效的Target.Count=1限制：支持用户批量修改单元格时的日期处理，更符合实际使用场景
• 正确关联监控范围：通过Intersect精准定位需要处理的单元格，避免无关单元格触发代码
• 逻辑修正：
  • 当监控单元格内容被清空时，立即清除右侧的日期
  • 当监控单元格有内容，且右侧单元格为空时，才写入当前时间，确保只记录首次修改日期
• 错误处理：通过ErrorHandler确保Application.EnableEvents始终被恢复，避免后续事件触发失效
• 多用户适配：代码执行效率高，2000行+10-20位用户的场景下不会有性能问题

内容的提问来源于stack exchange，提问作者Deepak Aggarwal