Excel предотвращает удаление ячейки и ее содержимого (без защиты листа)

Question

В моем листе Excel есть 2 столбца, которые я хочу защитить, чтобы вы не могли удалить ни ячейку, ни ее содержимое. Я не хочу использовать встроенную защиту листа, вместо этого я хочу использовать VBA (потому что пароль не требуется). Я нашел некоторый код, который должен предотвратить удаление клеток, но он не работает. Кроме того, я понятия не имею, как работает VBA, и поэтому я был бы рад, если бы кто-то мог либо предоставить решение, либо подсказать мне, как это сделать самому.

Код, который я нашел, это:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A6:B1048576")) Is Nothing Then Exit Sub
    On Error GoTo ExitPoint
    Application.EnableEvents = False
    If Not IsDate(Target(1)) Then
        Application.Undo
    End If
ExitPoint:
    Application.EnableEvents = True
End Sub

Answer 1

Это похоже на код в вашем вопросе, но предотвращает удаление любой ячейки в столбцах A:B / пустым:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    Dim b As Boolean

    On Error GoTo Terminate

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    For Each c In Target.Cells
        If Not Intersect(c, Range("A:B")) Is Nothing And c.Value = "" Then
            b = True
            GoTo UndoChange
        End If
    Next c

UndoChange:
    If b Then Application.Undo

Terminate:
    If Err Then
        Debug.Print "Error", Err.Number, Err.Description
        Err.Clear
    End If

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Он работает с несколькими вариантами выбора ячеек, поскольку он проходит по каждой ячейке в измененном диапазоне и проверяет пустое значение.

РЕДАКТИРОВАТЬ: исправленный код, чтобы интегрировать вашу существующую функциональность Worksheet_Change ;

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    Dim b As Boolean

    On Error GoTo Terminate

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    For Each c In Target.Cells
        If Not Intersect(c, Range("A:B")) Is Nothing And c.Value = "" Then
            b = True
            GoTo UndoChange
        End If
        If c.Column = 10 And c.Row >= 6 Then
            c.Value = UCase(c.Value)
        End If
    Next c

UndoChange:
    If b Then Application.Undo

Terminate:
    If Err Then
        Debug.Print "Error", Err.Number, Err.Description
        Err.Clear
    End If

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub