☰

Excel 防止单元格及其内容被删除（无工作表保护）

tag-icon • tag-icon microsoft-excel worksheet-function vba microsoft-excel-2016
Excel 防止单元格及其内容被删除（无工作表保护）

我的 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

答案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

相关内容