Excel VBA Worksheet_Change事件触发「发现内容问题」错误求助

错误原因 #

1. 事件递归循环：修改单元格数据验证规则时，会再次触发Worksheet_Change事件，导致无限递归，触发Excel的内容异常检测。
2. 空对象访问错误：代码中直接对Intersect(Target, rngF)进行循环，当Target与rngF无交集时，Intersect返回Nothing，此时循环会抛出错误。
3. 自定义验证公式逻辑错误：列K、L的自定义验证公式引用当前单元格本身（如=ISNUMBER(K" & cell.Row & ")），属于无效的自引用验证规则，会触发Excel内容检查报错。
4. 验证提示样式错误：使用xlValidAlertStop作为验证样式，该样式会强制阻断用户操作，不符合Excel数据验证的常规逻辑，容易被判定为内容异常。
5. 代码结构冗余：针对列F的处理被拆分为三个独立循环，未统一判断Target是否在rngF范围内，增加了出错概率。

修复后的完整代码 #

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsInput As Worksheet
    Dim rngInput As Range
    Dim rngOutput As Range
    Dim strOptions As String
    Dim i As Long
    Dim cell As Range
    Dim rngB As Range, rngF As Range, rngA As Range
    
    ' 禁用事件触发，避免递归循环
    Application.EnableEvents = False
    
    On Error GoTo Cleanup
    
    ' 初始化Input工作表和数据范围
    Set wsInput = ThisWorkbook.Sheets("Input")
    ' 处理Input表A列无数据的情况
    If wsInput.Cells(wsInput.Rows.Count, "A").End(xlUp).Row >= 2 Then
        Set rngInput = wsInput.Range("A2:C" & wsInput.Cells(wsInput.Rows.Count, "A").End(xlUp).Row)
    End If
    
    ' 处理A/B列变更，生成C列下拉选项
    If Not Intersect(Target, Target.Worksheet.Range("A:B")) Is Nothing Then
        For Each cell In Intersect(Target, Target.Worksheet.Range("A:B"))
            Set rngOutput = Target.Worksheet.Range("C" & cell.Row)
            rngOutput.Validation.Delete
            strOptions = ""
            
            If Not rngInput Is Nothing Then
                For i = 1 To rngInput.Rows.Count
                    If rngInput.Cells(i, 1) = Target.Worksheet.Cells(cell.Row, 1) And _
                       rngInput.Cells(i, 2) = Target.Worksheet.Cells(cell.Row, 2) Then
                        strOptions = strOptions & rngInput.Cells(i, 3) & ","
                    End If
                Next i
            End If
            
            If strOptions <> "" Then
                strOptions = Left(strOptions, Len(strOptions) - 1)
                ' 使用常规提示样式xlValidAlertInformation
                rngOutput.Validation.Add Type:=xlValidateList, _
                                        AlertStyle:=xlValidAlertInformation, _
                                        Formula1:=strOptions
            End If
        Next cell
    End If
    
    ' 定义目标列范围
    Set rngA = Target.Worksheet.Range("A2:A" & Target.Worksheet.Cells(Target.Worksheet.Rows.Count, "A").End(xlUp).Row)
    Set rngB = Target.Worksheet.Range("B2:B" & Target.Worksheet.Cells(Target.Worksheet.Rows.Count, "B").End(xlUp).Row)
    Set rngF = Target.Worksheet.Range("F2:F" & Target.Worksheet.Cells(Target.Worksheet.Rows.Count, "F").End(xlUp).Row)
    
    ' 处理A列变更，设置B列下拉选项
    If Not Intersect(Target, rngA) Is Nothing Then
        For Each cell In Intersect(Target, rngA)
            With Target.Worksheet.Range("B" & cell.Row)
                .Validation.Delete
                Select Case cell.Value
                    Case "CUTTING-2-", "ASSEMBLY-2-"
                        .Validation.Add Type:=xlValidateList, _
                                        AlertStyle:=xlValidAlertInformation, _
                                        Formula1:="IS,IH,DH"
                    Case Else
                        .Validation.Add Type:=xlValidateList, _
                                        AlertStyle:=xlValidAlertInformation, _
                                        Formula1:="IS,IH"
                End Select
            End With
        Next cell
    End If
    
    ' 处理B列变更，设置I列下拉选项
    If Not Intersect(Target, rngB) Is Nothing Then
        For Each cell In Intersect(Target, rngB)
            With Target.Worksheet.Range("I" & cell.Row)
                .Validation.Delete
                Select Case cell.Value
                    Case "IH"
                        .Validation.Add Type:=xlValidateList, _
                                        AlertStyle:=xlValidAlertInformation, _
                                        Formula1:="YES,NO"
                    Case "IS", "DH"
                        .Validation.Add Type:=xlValidateList, _
                                        AlertStyle:=xlValidAlertInformation, _
                                        Formula1:="NA"
                End Select
            End With
        Next cell
    End If
    
    ' 处理F列变更，设置J/K/L列验证规则
    If Not Intersect(Target, rngF) Is Nothing Then
        For Each cell In Intersect(Target, rngF)
            ' 设置J列验证
            With Target.Worksheet.Range("J" & cell.Row)
                .Validation.Delete
                Select Case cell.Value
                    Case "Replacement"
                        .Validation.Add Type:=xlValidateList, _
                                        AlertStyle:=xlValidAlertInformation, _
                                        Formula1:="Definitive, temporary"
                    Case "Investment"
                        .Validation.Add Type:=xlValidateList, _
                                        AlertStyle:=xlValidAlertInformation, _
                                        Formula1:="NA"
                End Select
            End With
            
            ' 设置K列验证（修正自引用问题，改为检查输入是否为数字）
            With Target.Worksheet.Range("K" & cell.Row)
                .Validation.Delete
                Select Case cell.Value
                    Case "Replacement"
                        .Validation.Add Type:=xlValidateCustom, _
                                        AlertStyle:=xlValidAlertInformation, _
                                        Formula1:="=ISNUMBER(" & .Address(False, False) & ")"
                    Case "Investment"
                        .Validation.Add Type:=xlValidateList, _
                                        AlertStyle:=xlValidAlertInformation, _
                                        Formula1:="NA"
                End Select
            End With
            
            ' 设置L列验证（修正自引用问题，改为检查输入是否为文本）
            With Target.Worksheet.Range("L" & cell.Row)
                .Validation.Delete
                Select Case cell.Value
                    Case "Replacement"
                        .Validation.Add Type:=xlValidateCustom, _
                                        AlertStyle:=xlValidAlertInformation, _
                                        Formula1:="=ISTEXT(" & .Address(False, False) & ")"
                    Case "Investment"
                        .Validation.Add Type:=xlValidateList, _
                                        AlertStyle:=xlValidAlertInformation, _
                                        Formula1:="NA"
                End Select
            End With
        Next cell
    End If

Cleanup:
    ' 恢复事件触发
    Application.EnableEvents = True
    On Error GoTo 0
End Sub

关键修改说明 #

• 新增Application.EnableEvents = False，避免修改验证规则时触发递归事件，执行完成后恢复事件状态。
• 优化数据范围的获取逻辑，避免工作表无数据时出现无效范围引用。
• 修正自定义验证公式的自引用问题，使用.Address(False, False)生成相对引用地址。
• 将验证提示样式从xlValidAlertStop改为xlValidAlertInformation，符合Excel常规验证交互逻辑。
• 整合列F的处理逻辑，减少冗余代码，统一判断Target是否在目标范围内，避免空对象错误。
• 遍历Target时增加Intersect判断，处理多单元格同时变更的场景。

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