如何在同一张Excel工作表中同时使用两个相似的Worksheet_Change子过程

报错根因 #

单个工作表代码模块内不允许定义两个同名的Worksheet_Change事件过程，VBA无法识别单元格变更时要触发哪段逻辑，因此同时保留两个同命名过程必然触发报错，只需将两段逻辑合并到同一个事件过程中即可解决。

合并后可用代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim WorkRng As Range
    Dim Rng As Range
    Dim xOffsetColumn As Integer
    
    ' 错误处理：避免中间异常导致事件锁死、工作表未保护
    On Error GoTo ErrHandler
    
    ActiveSheet.Unprotect Password:="incoming"
    Application.EnableEvents = False
    
    ' 原第一个Sub逻辑：B列变更时更新A列日期
    Set WorkRng = Intersect(Me.Range("B:B"), Target)
    xOffsetColumn = -1
    If Not WorkRng Is Nothing Then
        For Each Rng In WorkRng
            If Not VBA.IsEmpty(Rng.Value) Then
                Rng.Offset(0, xOffsetColumn).Value = Now
                Rng.Offset(0, xOffsetColumn).NumberFormat = "mm-dd-yyyy"
            Else
                Rng.Offset(0, xOffsetColumn).ClearContents
            End If
        Next
    End If
    
    ' 原第二个Sub逻辑：G列变更时更新I列日期
    Set WorkRng = Intersect(Me.Range("G:G"), Target)
    xOffsetColumn = 2
    If Not WorkRng Is Nothing Then
        For Each Rng In WorkRng
            If Not VBA.IsEmpty(Rng.Value) Then
                Rng.Offset(0, xOffsetColumn).Value = Now
                Rng.Offset(0, xOffsetColumn).NumberFormat = "mm-dd-yyyy"
            Else
                Rng.Offset(0, xOffsetColumn).ClearContents
            End If
        Next
    End If
    
ErrHandler:
    ' 统一恢复环境
    Application.EnableEvents = True
    ActiveSheet.Protect Password:="incoming"
    If Err.Number <> 0 Then MsgBox "执行出错：" & Err.Description, vbCritical
End Sub

调整说明 #

• 移除了重复的工作表解保护/保护、事件开关操作，仅在过程启动时统一解保护、关闭事件，所有逻辑执行完后统一恢复设置，减少冗余操作也避免异常漏恢复配置
• 两段原有逻辑完全保留，单独触发B列、G列变更的效果和之前单独运行两个Sub的效果完全一致
• 新增了错误捕获逻辑，避免中间代码异常导致EnableEvents永久关闭、工作表处于未保护状态的问题

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