受保护工作表VBA宏运行时删除单元格导致保护失效的问题

核心原理 #

使用Excel工作表保护的UserInterfaceOnly:=True参数，该参数允许工作表保持界面保护状态的同时，让VBA代码正常执行修改单元格、设置验证规则等操作，无需每次执行宏都手动解除/重新保护工作表。注意该参数不会随工作簿保存，需在工作簿打开时自动重新设置。

具体步骤 #

1. 添加工作簿打开事件 #

打开VBA编辑器，找到对应工作簿的ThisWorkbook模块，添加以下代码，确保每次打开工作簿时自动应用带UserInterfaceOnly的保护：

Private Sub Workbook_Open()
    ' 替换为你的目标工作表名称
    ThisWorkbook.Worksheets("你的工作表名称").Protect Password:="test", UserInterfaceOnly:=True, AllowFormattingCells:=True
End Sub

2. 修改原Worksheet_Change代码 #

移除原代码开头的ActiveSheet.Unprotect "test"语句，同时添加事件禁用逻辑避免循环触发，修改后的完整代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    Application.EnableEvents = False ' 防止修改单元格触发多次Change事件

    Dim str_line As Integer: str_line = 57
    Dim fin_line As Integer: fin_line = 1056
    Dim variante As Variant

    For i = str_line To fin_line
        If Not Intersect(Target, Range("AM" & i)) Is Nothing Then
            Select Case Range("AM" & i)
                Case "scenario 1", "":
                    Cells(i, 41) = ""
                    Cells(i, 44) = ""
            End Select
        End If
        
        If Not Intersect(Target, Range("G" & i)) Is Nothing Then
            If Range("G" & i) = "Review" Then
                Cells(i, 39) = ""
                Cells(i, 41) = ""
                Cells(i, 44) = ""
            End If
        End If
        
        If Not Intersect(Target, Range("D" & i)) Is Nothing Then
            If Range("D" & i) = "Full" Or Range("D" & i) = "Quota" Then
                Cells(i, 5) = ""
            End If
        End If
    Next i

    If Not Intersect(Target, Range("L17")) Is Nothing Then
        Select Case Range("L17")
            Case "yes":
                Sheets("Materiality Allocation").Columns("I:I").Hidden = False
                Sheets("Materiality Allocation").Columns("H:H").Hidden = False
            Case "no", "n/a", "":
                Sheets("Materiality Allocation").Columns("I:I").Hidden = True
                Sheets("Materiality Allocation").Columns("H:H").Hidden = True
                Range("I57:I1056").Value = ""
                For i = str_line To fin_line
                    If Cells(i, 8) <> "n/a" Then
                        Cells(i, 8) = "n/a"
                    End If
                Next i
        End Select
    End If

    For i = str_line To fin_line
        If Not Intersect(Target, Range("H" & i)) Is Nothing Then
            If Range("H" & i) = "no" Or Range("H" & i) = "n/a" Then
                Cells(i, 9) = ""
            End If
        End If
    Next i

    If Not Intersect(Target, Range("nb_components")) Is Nothing Then
        Range(Rows(str_line), Rows(fin_line)).Hidden = True
        If Range("nb_components").Value > 0 Then
            Range(Rows(str_line), Rows(str_line + Range("nb_components").Value - 1)).Hidden = False
        End If
    End If

    If Not Intersect(Target, Range("L22")) Is Nothing Then
        Range("AO57:AO1056").Value = " "
        Select Case Range("L22")
            Case "enhanced":
                variante = Array(Chr(160), "Normal", "Increased", "High")
                With Range("AO57:AO1056").Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=Join(variante, ",")
                    .IgnoreBlank = False
                    .InCellDropdown = True
                End With
            Case "standard":
                variante = Array(Chr(160), "Low", "Normal", "Increased", "High")
                With Range("AO57:AO1056").Validation
                    .Delete
                    .Add xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=Join(variante, ",")
                    .IgnoreBlank = False
                    .InCellDropdown = True
                End With
            Case "small entity":
                variante = Array(Chr(160), "Low", "Normal", "Increased", "High")
                With Range("AO57:AO1056").Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=Join(variante, ",")
                    .IgnoreBlank = True
                    .InCellDropdown = True
                End With
            Case Else:
                With Range("AO57:AO1056").Validation
                    .Delete
                End With
        End Select
    End If

    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True ' 恢复事件触发
End Sub

额外优化说明 #

• 新增Application.EnableEvents = False，避免代码修改单元格时循环触发Worksheet_Change事件，提升稳定性。
• 合并重复的Select Case分支，简化代码结构，减少冗余逻辑。

内容的提问来源于stack exchange，提问作者GBSH