Excel VBA：Worksheet Change事件代码执行异常及修复方案

需求与问题 #

需要实现工作表Change事件的两个逻辑：

• 第一部分：当用户编辑B2:H1000区域的单元格时，检查左侧单元格是否为空，若为空则撤销输入并弹出提示
• 第二部分：若第一部分未触发（即左侧单元格不为空），则为A2:H1000区域的编辑单元格添加时间戳并锁定相关单元格

遇到的问题：当第一部分逻辑触发时，使用End或Exit Sub会导致后续的Worksheet_Change事件完全失效，无法响应新的用户输入，需要实现仅终止当前代码执行，但不影响后续事件触发的效果。

原问题代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    
    '检查左侧单元格是否为空
    If Not Intersect(Target, Range("B2:H1000")) Is Nothing Then
        Application.EnableEvents = False
        Dim c As Range: Set c = Target.Offset(0, -1) '左侧单元格
        If IsEmpty(c.Value) Then '如果左侧单元格为空
            Application.Undo
            MsgBox "上一步未完成，输入已取消"
            End '终止代码，但导致事件永久关闭
        End If
    End If

    '满足上述条件时添加时间戳并锁定单元格
    If Not Intersect(Target, Range("A2:H1000")) Is Nothing Then
        Me.Unprotect Password:="check"
        Dim d As Range: Set d = Target.Offset(0, 35) '时间戳单元格（偏移35列）
        If IsEmpty(d.Value) Then '如果该单元格还没有时间戳
            d.Value = Now   '填充当前时间
            d.Locked = True '锁定时间戳单元格
        End If
        Target.Locked = True    '锁定输入单元格
        Me.Protect Password:="check", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, AllowSorting:=True
        Application.EnableEvents = True
    End If
End Sub

修复后的代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub

    '检查左侧单元格是否为空
    If Not Intersect(Target, Range("B2:H1000")) Is Nothing Then
        Application.EnableEvents = False
        Dim c As Range: Set c = Target.Offset(0, -1) '左侧单元格
        If IsEmpty(c.Value) Then '如果左侧单元格为空
            Application.Undo
            MsgBox "上一步未完成，输入已取消"
            Application.EnableEvents = True '恢复事件触发
            Exit Sub '终止当前代码执行，而非End
        End If
        Application.EnableEvents = True '非触发场景也要恢复事件
    End If

    '添加时间戳并锁定单元格
    If Not Intersect(Target, Range("A2:H1000")) Is Nothing Then
        Application.EnableEvents = False '提前关闭事件，避免循环触发
        Me.Unprotect Password:="check"
        Dim d As Range: Set d = Target.Offset(0, 35) '时间戳单元格（偏移35列）
        If IsEmpty(d.Value) Then '如果该单元格还没有时间戳
            d.Value = Now   '填充当前时间
            d.Locked = True '锁定时间戳单元格
        End If
        Target.Locked = True    '锁定输入单元格
        Me.Protect Password:="check", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, AllowSorting:=True
        Application.EnableEvents = True '恢复事件触发
    End If
End Sub

修复说明 #

1. 核心问题解决：原代码中触发左侧为空逻辑后，关闭了事件但未恢复就用End终止，导致Application.EnableEvents一直处于False状态，后续Change事件无法触发。修复后在终止当前代码前先恢复Application.EnableEvents = True，确保后续事件能正常响应。
2. 替换End为Exit Sub：End会直接终止整个VBA程序的执行，而Exit Sub仅退出当前过程，更符合需求；同时在非触发左侧为空的场景下，也要确保事件状态被恢复。
3. 事件逻辑优化：在第二部分逻辑开始前也主动关闭事件，避免代码中修改单元格（如写入时间戳）再次触发Change事件，造成循环。

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