Question

我正在处理的excel电子表格上运行的代码工作正常，期望当我复制并将信息导入受保护的单元格时，它会给我一个类型不匹配错误，并且无法弄清楚如何修复代码

    Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Intersect(Target, Range("C1:C20")) Is Nothing Then
        If Len(Trim(Target.Value)) = 0 Then Application.Undo
    End If

LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Answer 1

当您将多个值粘贴到C1：C20范围内的两个或多个单元格中时，目标大于1，您无法使用目标的Range.Value property。

通常，您会使用以下内容。

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("C1:C20")) Is Nothing Then
        'do not do anything until you know you are going to need it
        On Error GoTo Whoa
        Application.EnableEvents = False
        Dim crng As Range

        'in the event of a paste, Target may be multiple cells
        'deal with each changed cell individually
        For Each crng In Intersect(Target, Range("C1:C20"))
            If Len(Trim(crng.Value)) = 0 Then Application.Undo
            'the above undoes all of the changes; not just the indivual cell with a zero
        Next crng
    End If

LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

但是，您使用Application.Undo的愿望会带来一些独特的问题，因为您不想撤消所有更改的所有;只是导致零的那些。这是一个可能的解决方案。

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("C1:C20")) Is Nothing Then
        'do not do anything until you know you are going to need it
        On Error GoTo Whoa
        Application.EnableEvents = False
        Dim c As Long, crng As Range, vals As Variant, prevals As Variant
        'store the current values
        vals = Range("C1:C20").Value2
        'get the pre-change values back
        Application.Undo
        prevals = Range("C1:C20").Value2

        'in the event of a paste, Target may be multiple cells
        'deal with each changed cell individually
        For c = LBound(vals, 1) To UBound(vals, 1)
            If vals(c, 1) = 0 Then vals(c, 1) = prevals(c, 1)
        Next c
        Range("C1:C20") = vals
    End If

LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

新值存储在变量数组中，然后撤消粘贴。旧值存储在另一个变量数组中。新值将被遍历，如果出现零，则将其替换为旧值。最后，修订后的一组新值被粘贴回C1：C20范围。

Answer 2

您的工作表必须受到保护，因此您需要先取消保护工作表：

  Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Sheets("NameOfYourSheet").Unprotect Password:="YourPassWord" ' Change the name of the sheet which is locked
    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Intersect(Target, Range("C1:C20")) Is Nothing Then
        If Len(Trim(Target.Value)) = 0 Then Application.Undo
    End If

Sheets("NameOfYourSheet").Protect Password:="YourPassWord" 

LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Excel电子表格VBA代码不能一直工作

2 个答案: