Excel VBA Worksheet_Change事件数据验证失效问题求助

问题背景 #

需求：粘贴数据时触发数据验证与格式宏，当四个指定单元格区域（B4:M6、B9:M11、B48:M50）被修改时运行对应宏。
问题：原本可用的Worksheet_Change过程优化为单次错误弹窗后，数据验证错误不再触发，使用Counter统计验证失败次数的方法完全无效。

原代码核心问题分析 #

1. 验证范围完全错误：所有分支都在检查B4:M6的验证状态，而非当前被修改的目标区域，导致统计结果完全偏离实际情况。
2. 重复的条件分支：最后两个ElseIf均判断B48:M50，逻辑重复冗余，第四个分支永远不会被执行。
3. 冗余变量与操作：定义多个Counter变量、频繁切换工作表选择，既增加代码复杂度，又容易引发无意义的错误。
4. 未处理递归事件：修改单元格格式或值时会再次触发Worksheet_Change，导致逻辑混乱、重复执行。
5. 无错误捕获机制：若单元格未设置数据验证规则，Validation.Value会直接抛出错误中断程序运行。

修复后的代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim checkRange As Range
    Dim cell As Range
    Dim errorCount As Integer
    Dim isProtected As Boolean
    
    ' 禁用事件，避免递归触发Change过程
    Application.EnableEvents = False
    Set ws = ThisWorkbook.Sheets("Cell Count Sheet")
    isProtected = ws.ProtectContents ' 记录工作表初始保护状态
    
    On Error Resume Next ' 捕获无数据验证单元格的报错
    
    ' 匹配触发修改的目标区域
    If Not Intersect(Target, Me.Range("B4:M6")) Is Nothing Then
        Set checkRange = ws.Range("B4:M6")
    ElseIf Not Intersect(Target, Me.Range("B9:M11")) Is Nothing Then
        Set checkRange = ws.Range("B9:M11")
    ElseIf Not Intersect(Target, Me.Range("B48:M50")) Is Nothing Then
        ' 原代码此处重复，保留单一条件逻辑，如需区分其他场景可自行扩展
        If ws.Range("B48").Value = 1 Then
            Set checkRange = ws.Range("B48:M50")
        End If
    End If
    
    ' 仅当存在有效检查区域时执行后续逻辑
    If Not checkRange Is Nothing Then
        ' 取消工作表保护（仅当原本处于保护状态时）
        If isProtected Then ws.Unprotect "ABC123"
        
        ' 调用格式处理与平均值检查宏
        Call Cell_Count_Formatting
        Call Cell_Count_Average_Check
        
        ' 统计当前区域的验证错误数量
        errorCount = 0
        For Each cell In checkRange
            If cell.Validation.Value = False Then
                errorCount = errorCount + 1
            End If
        Next cell
        
        ' 处理验证错误情况
        If errorCount > 0 Then
            ws.CircleInvalid
            MsgBox "至少有一个粘贴值不符合单元格的数据验证规则" & vbNewLine & _
                   "请确认单元格计数已粘贴到正确位置。" & vbNewLine & _
                   "不符合规则的数据已被圈出，请检查所有圈选数据。", _
                   vbOKOnly + vbExclamation, "数据验证错误"
            ws.CircleInvalid
        Else
            ' 恢复工作表保护状态
            If isProtected Then ws.Protect "ABC123"
        End If
    End If
    
    ' 恢复事件触发与错误处理机制
    On Error GoTo 0
    Application.EnableEvents = True
End Sub

关键修复说明 #

• 修正验证范围：每个分支对应检查当前触发修改的单元格区域，确保统计结果真实反映修改区域的验证状态。
• 移除重复分支：合并冗余的B48:M50判断逻辑，清理无效代码路径。
• 禁用递归事件：添加Application.EnableEvents = False，防止修改格式时反复触发Change过程。
• 优化工作表操作：用对象变量直接引用目标工作表，避免频繁的Select操作，提升代码稳定性与执行效率。
• 合并错误弹窗：将两个拆分的提示框合并为一个，既实现单次弹窗需求，又保留所有必要提示信息。
• 添加错误捕获：通过On Error Resume Next处理无数据验证单元格的报错，避免程序意外中断。
• 保留原保护状态：记录工作表初始保护状态，仅在需要时临时取消保护，操作完成后自动恢复。

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