VBA Worksheet Change事件下数据验证（DV）错误排查求助

问题核心 #

• 手动输入G至N列单元格后，VBA添加的自定义数据验证（DV）公式残留，再次修改单元格时触发DV错误提示
• 清空单元格后DV公式仍保留，但通过VBA修改单元格无此问题

代码变更背景 #

原代码因Select Case myCell.Address报错，修改为Select Case Target.Address，同时将rngG.Validation改为Target.Validation以避免整列触发DV错误，新增目标列范围后引发当前问题。

问题根源 #

当前代码存在两个关键缺陷：

1. 仅在单元格匹配特定地址时添加DV，但未在后续变更或清空时删除已添加的DV，导致规则永久残留
2. 从整列DV操作改为单个单元格操作后，缺少针对单个单元格的DV生命周期管理逻辑

解决方案 #

1. 核心修改：添加DV清理逻辑 #

在处理每列的Change事件时，先删除当前Target单元格的现有DV，再按需添加新规则；空单元格直接不添加DV。

修改后的完整核心代码片段：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngB As Range, rngG As Range, rngH As Range, rngI As Range, rngJ As Range
    Set rngB = Range("B7:B35")
    Set rngG = Range("G7:G35")
    Set rngH = Range("H7:H35")
    Set rngI = Range("I7:I35")
    Set rngJ = Range("J7:J35")
    
    rngG.NumberFormat = "$#,##0.00"  
    rngH.NumberFormat = "0.00%"      
    rngI.NumberFormat = "$#,##0.00"  
    rngJ.NumberFormat = "$#,##0.00"  
    
    On Error GoTo ErrHandler 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    ' Col B变更：清空行并删除对应单元格DV
    If Not Intersect(Target, rngB) Is Nothing Then
        With Target
            ' 清空内容
            Range(.Offset(0,2), .Offset(0,8)).ClearContents
            ' 删除对应单元格的DV
            Range(.Offset(0,5), .Offset(0,8)).Validation.Delete
            
            If .Value = "" Then
                Range(.Offset(0,2), .Offset(0,8)).ClearContents
                Range(.Offset(0,5), .Offset(0,8)).Validation.Delete
            End If
        End With
    End If

    ' Col G变更：先清理DV再按需添加
    If Not Intersect(Target, rngG) Is Nothing Then
        ' 先删除当前单元格的现有DV
        Target.Validation.Delete
        
        ' 仅当单元格非空时添加验证规则
        If Target.Value <> "" Then
            Select Case Target.Address
                Case "$G$7"
                    With Target.Validation
                        .Add Type:=xlValidateCustom, _
                        AlertStyle:=xlValidAlertStop, _
                        Operator:=xlBetween, _
                        Formula1:="IF(AND(XLOOKUP($F7,Merge1!$E$2#,XLOOKUP(G$6,Merge1!$F$1#,Merge1!$F$2:$V$25)),ISNUMBER(G7))=TRUE,TRUE,FALSE)"
                        .IgnoreBlank = True
                        .InCellDropdown = False
                        .ShowInput = False
                        .ShowError = True
                    End With
                ' 其他G列单元格的规则...
            End Select
        End If
    End If

    ' Col H及其他列的处理逻辑同理，先清理DV再按需添加
    If Not Intersect(Target, rngH) Is Nothing Then
        Target.Validation.Delete
        If Target.Value <> "" Then
            Select Case Target.Address
                ' H列对应规则...
            End Select
        End If
    End If

ErrHandler:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End If
    If Err.Number <> 0 Then MsgBox Err.Description, vbExclamation
End Sub

2. 额外优化建议 #

• 避免硬编码单元格地址（如$G$7），改用Target.Row或Target.Column动态判断，提升代码可维护性：

  ' 示例：判断是否为G7单元格
  If Target.Column = 7 And Target.Row = 7 Then
      ' 添加DV规则
  End If
  

• 确保所有列的Change事件都遵循“先清理DV，再按需添加”的逻辑，避免遗漏

效果验证 #

修改后：

• 手动输入单元格时，仅在非空状态下添加DV规则
• 修改或清空单元格时，旧DV规则会被自动删除，不会触发错误提示
• 清空整行时，对应单元格的DV也会被同步删除

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