编辑工作表中任何单元格时，应用程序定义的或对象定义的错误

Question

我是相对较新的VBA，并设法编辑了一个worksheet_change子程序的例子代码找到在线(谢谢提姆威廉姆斯！)这允许在指定行内的下拉列表中进行多个选择和取消选择，同时在编辑父下拉列表时清除依赖的单元格内容。

我确实有另一个版本，它可以实现一个处理，包括多个分隔符“、”、“和”to，以构造简短的句子/列表，但不允许替换。我一直在努力将包含替代选择的示例代码与清除单个Private中的数据的其他代码结合起来。我已经找到了许多不同的方法，但是使用Tim在另一个线程上发布的代码是我最接近找到的方法。但是每当我尝试编辑一个单元格时，我都会在excel中弹出一个“应用程序定义的或对象定义的错误”，我不知道为什么。

与其相关的工作表将在同一个工作簿中复制10次甚至100次，而工作簿本身也将被复制，因此没有工作表或工作簿参考资料。

如果有人能发现我的错误并建议如何纠正他们，我将非常感激。谢谢。这是密码。

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const SEP As String = ", "
    Dim c As Range, Newvalue As String, Oldvalue As String, arr, v, lst, removed As Boolean
    Application.EnableEvents = True
    On Error GoTo Exitsub
    

    If Target.Row = 14 And Target.Validation.Type = 3 Then
        Target.Offset(1, 0).ClearContents
        Target.Offset(2, 0).ClearContents
    End If
        If Target.Row = 20 And Target.Validation.Type = 3 Then
        Target.Offset(2, 0).ClearContents
    End If

    If Target.Row = 15 Or 16 Or 17 Or 21 Or 22 Or 28 Or 29 Or 31 Or 33 Then
    
    If Target.CountLarge > 1 Then Exit Sub '<< only handling single-cell changes

    Select Case Target.Row
        Case 15, 16, 17, 21, 22, 28, 29, 31, 33
            Set c = Target
        Case Else: Exit Sub
        End Select
    
    If Len(c.Value) > 0 And Not c.Validation Is Nothing Then

        Application.EnableEvents = False
        Newvalue = c.Value
        Application.Undo
        Oldvalue = c.Value

        If Oldvalue = "" Then
            c.Value = Newvalue
        Else
            arr = Split(Oldvalue, SEP)
            'loop over previous list, removing newvalue if found
            For Each v In arr
                If Trim(CStr(v)) = Newvalue Then
                    removed = True
                Else
                    lst = lst & IIf(lst = "", "", SEP) & v
                End If
            Next v
            'add the new value if we didn't just remove it
            If Not removed Then lst = lst & IIf(lst = "", "", SEP) & Newvalue
            c.Value = lst
        End If
    End If
    End If    'has validation and non-empty
    Exitsub:
    If Err.Number <> 0 Then MsgBox Err.Description
    Application.EnableEvents = True
End Sub

Answer 1

轻度试验：

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const SEP As String = ", "
    Dim c As Range, Newvalue As String, Oldvalue As String, arr, v, lst, removed As Boolean
    
    'Application.EnableEvents = True 'this only runs if EnableEvents is *already* True...
    On Error GoTo Exitsub
    
    If Target.CountLarge > 1 Then Exit Sub '<< only handling single-cell changes
    
    Set c = Target
    If Not HasListValidation(c) Then Exit Sub 'exit if cell has no list validation
    
    'you can handle all the row checking here...
    Select Case c.Row
        Case 14
            c.Offset(1, 0).Resize(2, 1).ClearContents
            Exit Sub  'added
        Case 20
            c.Offset(2, 0).ClearContents
            Exit Sub  'added
        Case 15, 16, 17, 21, 22, 28, 29, 31, 33 'ok to proceed
        Case Else: Exit Sub
    End Select
    
    If Len(c.Value) > 0 Then

        Application.EnableEvents = False
        Newvalue = c.Value
        Application.Undo
        Oldvalue = c.Value

        If Oldvalue = "" Then
            c.Value = Newvalue
        Else
            arr = Split(Oldvalue, SEP)
            'loop over previous list, removing newvalue if found
            For Each v In arr
                If Trim(CStr(v)) = Newvalue Then
                    removed = True
                Else
                    lst = lst & IIf(lst = "", "", SEP) & v
                End If
            Next v
            'add the new value if we didn't just remove it
            If Not removed Then lst = lst & IIf(lst = "", "", SEP) & Newvalue
            c.Value = lst
        End If
    End If  'c not empty
    
Exitsub:
    If Err.Number <> 0 Then MsgBox Err.Description
    Application.EnableEvents = True
End Sub

'does a cell have a List validation applied?
Function HasListValidation(c As Range) As Boolean
    Dim v
    On Error Resume Next
    v = c.Validation.Type
    On Error GoTo 0
    HasListValidation = (v = xlValidateList) '3
End Function