修改首个VBA代码后第二个Worksheet_Change事件失效，如何兼容运行？

问题原因 #

Excel工作表的事件过程是唯一的，同一个事件（如Worksheet_Change）只能存在一个同名的过程。你添加两段同名的Worksheet_Change代码后，只有第一段代码会生效，第二段会被系统忽略。

解决方案：合并两段代码到同一个事件过程 #

将两段代码的逻辑整合到同一个Worksheet_Change过程中，同时统一管理Application.EnableEvents和Application.ScreenUpdating，避免设置冲突或递归触发事件。

合并后的完整代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
    Dim CurrCell As Range
    Dim TargetWidth As Single, PossNewRowHeight As Single
    Dim Oldvalue As String
    Dim Newvalue As String
    
    ' 初始化应用设置，避免递归触发事件和屏幕闪烁
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    On Error GoTo Cleanup ' 统一错误处理，确保恢复设置
    
    ' --- 第一段代码：合并单元格自动调整行高逻辑 ---
    If Target.MergeCells Then
        With Target.MergeArea
            If .Rows.Count = 1 And .WrapText = True Then
                CurrentRowHeight = .RowHeight
                TargetWidth = Target.ColumnWidth
                MergedCellRgWidth = 0 ' 重置宽度累加值，避免残留值影响
                For Each CurrCell In .Cells ' 替换原Selection，改用MergeArea的Cells更准确
                    MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
                Next
                .MergeCells = False
                .Cells(1).ColumnWidth = MergedCellRgWidth
                .EntireRow.AutoFit
                PossNewRowHeight = .RowHeight
                .Cells(1).ColumnWidth = TargetWidth
                .MergeCells = True
                .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight)
            End If
        End With
    End If
    
    ' --- 第二段代码：E19单元格的下拉列表多选逻辑 ---
    If Target.Address = "$E$19" Then
        On Error Resume Next ' 临时忽略SpecialCells的错误
        Dim validationCheck As Range
        Set validationCheck = Target.SpecialCells(xlCellTypeAllValidation)
        On Error GoTo Cleanup ' 恢复全局错误处理
        
        If validationCheck Is Nothing Then GoTo Cleanup
        If Target.Value = "" Then GoTo Cleanup
        
        Newvalue = Target.Value
        Application.Undo
        Oldvalue = Target.Value
        
        If Oldvalue = "" Then
            Target.Value = Newvalue
        Else
            If InStr(1, Oldvalue, Newvalue) = 0 Then
                Target.Value = Oldvalue & vbNewLine & Newvalue
            Else
                Target.Value = Oldvalue
            End If
        End If
    End If

Cleanup:
    ' 恢复应用设置，无论是否出错都执行
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

关键修改说明 #

1. 统一事件过程：将两段代码合并到同一个Worksheet_Change中，解决同名过程冲突问题。
2. 优化应用设置管理：开头统一关闭EnableEvents和ScreenUpdating，避免递归触发事件和屏幕闪烁；错误处理块统一恢复设置，确保即使出错也不会导致后续事件失效。
3. 修复第一段代码的小问题：把原代码的Selection改为Target.MergeArea.Cells，避免选中其他区域时逻辑出错；同时重置MergedCellRgWidth初始值为0，防止残留值影响计算。
4. 调整错误处理：在第二段代码的SpecialCells检查处添加临时错误忽略，避免因单元格无验证规则时抛出错误中断整个过程。

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