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

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

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，并且不能使用Target的Range.Value属性 。

通常情况下，你会使用类似下面的东西。

 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的愿望提出了一些独特的问题，因为您不想撤销所有的更改; 只是导致零的那些。 这是一个可能的解决scheme。

 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 

新值存储在一个variables数组中，然后粘贴被撤消。 旧值存储在另一个variables数组中。 新的值被传递，如果零出现，它将被replace为旧的值。 最后，修改后的一组新值被粘贴回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