Экземпляр таблицы Excel код не работает полностью

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

Ваш лист должен быть защищен, так что вам нужно снять защиту вашего листа первым:

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 

Answer 2

При вставке количества значений в двух или более ячеек в пределах 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.