Excel VBA Worksheet_Change宏因数据验证错误触发崩溃求助

你的Excel崩溃问题主要是由Worksheet_Change宏的几个关键缺陷导致的，以下是修复后的代码和核心修改说明：

修复后的完整代码 #

Option Explicit
Dim Monitored

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 禁用事件触发，避免修改单元格时循环调用宏
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    On Error GoTo Cleanup ' 错误捕获，确保异常时能恢复Excel状态
    
    Dim KeyCells As Range
    Set KeyCells = Me.Range("A1:M157") ' 用Me指代当前工作表，避免硬编码Sheet1
    
    ' 处理Target为多单元格的情况，只关注单个单元格变化
    If Target.Cells.CountLarge > 1 Then GoTo Cleanup
    
    If Not Application.Intersect(KeyCells, Target) Is Nothing Then
        ' 控制行显示/隐藏：Regelmäßigkeit
        Select Case Me.Range("L38").Value
            Case "Nein"
                Me.Rows("42:44").Hidden = True
            Case "Ja"
                Me.Rows("42:44").Hidden = False
        End Select
        
        ' 控制行显示/隐藏：Extra Frage判断
        If Me.Range("C99").Value = "17. Bitte beachten Sie folgende Besonderheiten:" Then
            Me.Rows("98:103").Hidden = True
        Else
            Me.Rows("98:103").Hidden = False
        End If
        
        Dim sumX As Long
        Dim isExtraFrageVisible As Boolean
        isExtraFrageVisible = Not Me.Rows("98:103").Hidden
        
        ' 检查是否有未完成项（P列的X）
        Dim hasIncomplete As Boolean
        If isExtraFrageVisible Then
            hasIncomplete = (Application.CountIf(Me.Range("P1:P99"), "X") > 0)
        Else
            hasIncomplete = (Application.CountIf(Me.Range("P1:P97"), "X") > 0)
        End If
        
        ' 设置C106的值
        If hasIncomplete Then
            Me.Range("C106").Value = Sheet2.Range("A53").Value
        Else
            ' 用Application.CountIf替代WorksheetFunction，避免无匹配时抛错
            Dim isE25InSheet2 As Boolean
            isE25InSheet2 = (Application.CountIf(Sheet2.Range("H3:H229"), Me.Range("E25").Value) > 0)
            
            If isE25InSheet2 Then
                If isExtraFrageVisible Then
                    sumX = Application.CountIf(Me.Range("O1:O99"), "X")
                    If sumX = 17 Then
                        Me.Range("C106").Value = Sheet2.Range("A33").Value
                    ElseIf sumX < 17 Then
                        Me.Range("C106").Value = Sheet2.Range("A43").Value
                    End If
                Else
                    sumX = Application.CountIf(Me.Range("O1:O97"), "X")
                    If sumX = 16 Then
                        Me.Range("C106").Value = Sheet2.Range("A33").Value
                    ElseIf sumX < 16 Then
                        Me.Range("C106").Value = Sheet2.Range("A43").Value
                    End If
                End If
            Else
                Me.Range("C106").Value = Sheet2.Range("A43").Value
            End If
        End If
        
        ' 颜色标记
        Select Case Me.Range("C106").Value
            Case Sheet2.Range("A33").Value
                Me.Range("C106").Interior.ColorIndex = 43
            Case Sheet2.Range("A43").Value
                Me.Range("C106").Interior.ColorIndex = 44
            Case Sheet2.Range("A53").Value
                Me.Range("C106").Interior.ColorIndex = 46
        End Select
    End If

Cleanup:
    ' 恢复Excel的正常状态，无论是否出错都执行
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    If Err.Number <> 0 Then
        MsgBox "宏执行出错: " & Err.Description, vbExclamation
    End If
End Sub

核心修改点说明 #

• 禁用事件触发：添加Application.EnableEvents = False，避免宏修改C106单元格时再次触发Worksheet_Change，造成无限循环导致崩溃。
• 错误捕获与状态恢复：新增On Error GoTo Cleanup分支，确保无论宏是否出错，都能恢复ScreenUpdating和EnableEvents的正常状态，避免Excel一直处于异常状态。
• 处理多单元格Target：判断Target.Cells.CountLarge > 1时直接跳转到清理逻辑，避免批量修改单元格时引发引用错误。
• 替换WorksheetFunction为Application：用Application.CountIf替代Application.WorksheetFunction.CountIf，当无匹配项时不会抛出运行时错误，而是返回0，提升代码稳定性。
• 简化代码结构：用Select Case替代重复的ElseIf，提取重复逻辑为变量（如isExtraFrageVisible），提升可读性和维护性。
• 使用Me指代当前工作表：避免硬编码Sheet1，确保宏绑定到当前工作表时的兼容性。

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