VBA Combo1_Change事件数据验证触发对象定义错误求助

在以下VBA代码中，Combo1_Change事件的逻辑是：当Sheet39的D8单元格值为"Client Reference 1 Field Value (600)"时移除指定区域的数据验证，否则重新添加数据验证，但执行时触发「对象定义错误」，需排查修复。

原代码如下：

Worksheet_Change 事件代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    If ActiveSheet.CodeName = "Sheet39" Then
        If Not Application.Intersect(Target, Range("B10, F10, J10, N10, R10,V10,Z10,AD10,AH10,AL10,AP10,AT10,AX10,BB10,BF10,BJ10,BN10,BR10,BV10,BZ10")) Is Nothing Then
            Application.ScreenUpdating = False
            cpm = ActiveCell.Address
            
            Dim free_text_prefs As Variant
            Dim email_prefs As Variant
            Dim numeric_prefs As Variant
            Dim text_prefs As Variant
            free_text_prefs = Array("4", "5", "6", "26", "31", "33", "34", "36", "55", "57", "72", "73", "74", "100", "101", "103", "108", "122", "142", "170", "200", "201", "202", "205", "206", "207", "210", "226", "229", "230", "255", "267", "268", "406", "510", "514", "539", "600", "601", "677", "715", "750", "763", "807", "821", "822", "826", "827", "838", "846", "847", "850", "906", "916", "918", "931", "949", "954", "974", "983", "984", "990", "996", "1013", "1041", "1051", "1059", "1091", "1119", "1129", "1246", "1247", "1249", "1290", "1304", "1319", "1327", "1341", "1344", "1347", "1352", "1377", "1398", "1401", "1405", "1409", "1415", "1423", "1424", "1479")
            email_prefs = Array("4", "229", "255", "750", "821", "822", "916", "974", "1119", "1304", "1468", "1475")
            numeric_prefs = Array("201", "202", "1409")
            text_prefs = Array("26", "31")
            acvc = ActiveCell.Column
            acvr = ActiveCell.Row
            
            If Not IsError(Sheet39.Cells(8, acvc).Value) Then
                If Not IsEmpty(Sheet39.Cells(8, acvc).Value) Then ' <> "" Then
                    If isInArray(Sheet39.Cells(8, acvc).Value, email_prefs) Then
                        Sheet39.Cells(6, acvc + 1).Value = "Pref value must be an email id"
                    ElseIf isInArray(Sheet39.Cells(8, acvc).Value, numeric_prefs) Then
                        Sheet39.Cells(6, acvc + 1).Value = "Pref value must be numeric"
                    ElseIf isInArray(Sheet39.Cells(8, acvc).Value, free_text_prefs) Then
                        Sheet39.Cells(6, acvc + 1).Value = "Pref value is a free text"
                    Else
                        Sheet39.Cells(6, acvc + 1).Value = "Pref value to be picked from Dropdown"
                    End If
                Else
                    Sheet39.Cells(6, acvc + 1).Value = ""
                End If
                
                If Not IsEmpty(Target.Value) Then ' <> "" Then
                    colLetter = ""
                    If isInArray(Sheet39.Cells(8, acvc).Value, free_text_prefs) Then
                        colLetter = Split(Cells(1, acvc + 1).Address, "$")(1)
                        With Sheet39.Range(colLetter & "10:" & colLetter & "3009").Validation
                            Call .Delete
                            IgnoreBlank = True
                        End With
                    Else
                        colLetter = Split(Cells(1, acvc + 1).Address, "$")(1)
                        ' MsgBox ("Validation in place  " & acvc + 2 & colLetter)
                        With Sheet39.Range(colLetter & "10:" & colLetter & "3009").Validation
                            Call .Delete
                            Call .Add(Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=OFFSET(Ref!$A$851,1,MATCH(" & colLetter & "$8,Ref!$A$851:$YJ$851,0)-1,COUNTA(OFFSET(Ref!$A$851,1,MATCH(" & colLetter & "$8,Ref!$A$851:$YJ$851,0)-1,1002)))")
                        End With
                    End If
                End If
            Else
                MsgBox ("Select a Pref from the dropdown")
            End If
        End If
    End If
End Sub

Combo1_Change 事件代码 #

Private Sub Combo1_Change()
    Dim i As Long
    Dim colLetter As String
    
    If Not IsArrow Then
        With Me.Combo1
            .List = Worksheets("Account Preferences").Range("CC3", Worksheets("Account Preferences").Cells(Rows.Count, "CC").End(xlUp)).Value
            .ListRows = Application.WorksheetFunction.Min(15, .ListCount)
            .DropDown
            If Len(.Text) Then
                For i = .ListCount - 1 To 0 Step -1
                    If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i
                Next
                .DropDown
            End If
        End With
    End If
    
    ' Additional condition to remove data validation based on D8 value
    colLetter = Split(Cells(1, acvc + 1).Address, "$")(1)
    If Sheet39.Range("D8").Value = "Client Reference 1 Field Value (600)" Then
        With Sheet39.Range(colLetter & "10:" & colLetter & "3009").Validation
            Call .Delete
        End With
    Else
        colLetter = Split(Cells(1, acvc + 1).Address, "$")(1)
        With Sheet39.Range(colLetter & "10:" & colLetter & "3009").Validation
            Call .Delete
            Call .Add(Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=OFFSET(Ref!$A$851,1,MATCH(" & colLetter & "$8,Ref!$A$851:$YJ$851,0)-1,COUNTA(OFFSET(Ref!$A$851,1,MATCH(" & colLetter & "$8,Ref!$A$851:$YJ$851,0)-1,1002)))")
        End With
    End If
End Sub

• 变量acvc未定义赋值：Combo1_Change事件直接使用了acvc变量，但该变量仅在Worksheet_Change中定义，当前事件未初始化，导致后续列字母获取代码报错。
• 未限定工作表的Cells引用：Cells(1, acvc + 1)默认指向当前活动工作表，若活动表不是Sheet39，会获取错误的列字母。
• 数据验证删除无存在性检查：如果目标区域原本没有数据验证，直接调用.Delete会触发对象错误。
• 冗余代码：Else分支重复计算colLetter，无实际意义。

Private Sub Combo1_Change()
    Dim i As Long
    Dim colLetter As String
    Dim targetCol As Long ' 新增变量存储目标列
    
    If Not IsArrow Then
        With Me.Combo1
            .List = Worksheets("Account Preferences").Range("CC3", Worksheets("Account Preferences").Cells(Rows.Count, "CC").End(xlUp)).Value
            .ListRows = Application.WorksheetFunction.Min(15, .ListCount)
            .DropDown
            If Len(.Text) Then
                For i = .ListCount - 1 To 0 Step -1
                    If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i
                Next
                .DropDown
            End If
        End With
    End If
    
    ' 1. 明确指定目标列：示例为D列的下一列（E列），可根据实际逻辑调整
    targetCol = Sheet39.Range("D8").Column + 1
    ' 2. 限定Sheet39获取列字母，避免活动表干扰
    colLetter = Split(Sheet39.Cells(1, targetCol).Address, "$")(1)
    
    With Sheet39.Range(colLetter & "10:" & colLetter & "3009").Validation
        ' 3. 先检查是否存在数据验证，再删除
        If .Type <> xlValidateNone Then
            .Delete
        End If
    End With
    
    ' 4. 重构逻辑：删除后根据条件添加验证，减少冗余判断
    If Sheet39.Range("D8").Value <> "Client Reference 1 Field Value (600)" Then
        With Sheet39.Range(colLetter & "10:" & colLetter & "3009").Validation
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, _
                 Formula1:="=OFFSET(Ref!$A$851,1,MATCH(" & colLetter & "$8,Ref!$A$851:$YJ$851,0)-1,COUNTA(OFFSET(Ref!$A$851,1,MATCH(" & colLetter & "$8,Ref!$A$851:$YJ$851,0)-1,1002)))"
        End With
    End If
End Sub

关键修改说明 #

• 新增targetCol变量，明确指定需要操作的列（示例为D列下一列，可根据业务逻辑调整，比如关联Combo1选中项）。
• 限定Cells引用为Sheet39，确保列字母获取准确。
• 删除数据验证前先检查是否存在，避免无验证时触发错误。
• 重构逻辑：先统一删除验证，再根据条件决定是否添加，简化代码结构。

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