如何在Worksheet_Change事件VBA代码后半段添加工作表密码保护逻辑

代码第一部分通过If ActiveSheet.ProtectContents逻辑实现了「操作前解锁工作表、操作完成后重新锁定」的功能，但尝试将该逻辑整合到代码后半段时始终无法生效，复制第一部分的Else结构及相关命令也没用。完整代码如下：

Sub Worksheet_Change(ByVal Target As Range)
   If Target.Address = "$M$10" Then
   If Target.Value > 0 Then
            If ActiveSheet.ProtectContents Then
               ActiveSheet.Unprotect Password:="TL1234Kvalitet"
               Rows("18:19").EntireRow.Hidden = False
               ActiveSheet.Protect Password:="TL1234Kvalitet"
            Else
                Rows("18:19").EntireRow.Hidden = False
            End If
       Else
            If ActiveSheet.ProtectContents Then
               ActiveSheet.Unprotect Password:="TL1234Kvalitet"
               Rows("18:19").EntireRow.Hidden = True
               ActiveSheet.Protect Password:="TL1234Kvalitet"
            Else
                Rows("18:19").EntireRow.Hidden = True
           End If
       End If
   End If
    
'/// 2nd half
    
    Dim ws As Worksheet: Set ws = Target.Worksheet
    Dim tcell As Range: Set tcell = ws.Range("M3")
    If Intersect(tcell, Target) Is Nothing Then Exit Sub
    
    Dim tString As String: tString = CStr(tcell.Value)
    
   If InStr(1, tString, "Halv" & ChrW(229) & "r ", vbTextCompare) > 0 Then
        With ws.Range("C41:E54")
            '.Interior.Color = RGB(255, 255, 255) ' white background
            .Font.Color = RGB(255, 255, 255) ' white font
            .Interior.Pattern = xlNone
            .Interior.TintAndShade = 0
            .Interior.PatternTintAndShade = 0
            
        End With
    Call Makro4
    
    ElseIf InStr(1, tString, "Kvartal ", vbTextCompare) > 0 Then ' is equal
        With ws.Range("C42:C46,C50:C54,E42:E46,E50:E54")
            .Interior.Color = RGB(255, 255, 0) 'yellow background
            .Font.Color = RGB(0, 0, 0) 'black font
        End With
        With ws.Range("C47:E47")
            .Font.Color = RGB(0, 0, 0)
        End With
    Call Makro5
    
    Else
        
    End If
End Sub

解决方法：统一处理保护状态+简化逻辑 #

重复复制解锁/锁定逻辑容易出错，建议统一处理工作表保护状态，避免代码冗余的同时确保逻辑生效：

修改后的完整代码

Sub Worksheet_Change(ByVal Target As Range)
    Const PWD As String = "TL1234Kvalitet"
    Dim ws As Worksheet: Set ws = Target.Worksheet
    
    ' 第一部分：处理M10单元格变化
    If Target.Address = "$M$10" Then
        Dim hideRows As Boolean
        hideRows = (Target.Value <= 0)
        
        ' 统一处理保护状态
        Dim wasProtected As Boolean
        wasProtected = ws.ProtectContents
        If wasProtected Then ws.Unprotect Password:=PWD
        
        Rows("18:19").EntireRow.Hidden = hideRows
        
        If wasProtected Then ws.Protect Password:=PWD
    End If
    
    ' 第二部分：处理M3单元格变化
    Dim tcell As Range: Set tcell = ws.Range("M3")
    If Intersect(tcell, Target) Is Nothing Then Exit Sub
    
    Dim tString As String: tString = CStr(tcell.Value)
    
    ' 统一处理保护状态
    wasProtected = ws.ProtectContents
    If wasProtected Then ws.Unprotect Password:=PWD
    
    If InStr(1, tString, "Halv" & ChrW(229) & "r ", vbTextCompare) > 0 Then
        With ws.Range("C41:E54")
            '.Interior.Color = RGB(255, 255, 255) ' white background
            .Font.Color = RGB(255, 255, 255) ' white font
            .Interior.Pattern = xlNone
            .Interior.TintAndShade = 0
            .Interior.PatternTintAndShade = 0
        End With
        Call Makro4
    ElseIf InStr(1, tString, "Kvartal ", vbTextCompare) > 0 Then
        With ws.Range("C42:C46,C50:C54,E42:E46,E50:E54")
            .Interior.Color = RGB(255, 255, 0) 'yellow background
            .Font.Color = RGB(0, 0, 0) 'black font
        End With
        With ws.Range("C47:E47")
            .Font.Color = RGB(0, 0, 0)
        End With
        Call Makro5
    End If
    
    ' 恢复保护状态
    If wasProtected Then ws.Protect Password:=PWD
End Sub

关键优化点：

1. 将密码定义为常量PWD，避免重复输入，后续修改更便捷
2. 统一在操作前判断保护状态、解锁，操作完成后恢复保护，替代分散的条件判断
3. 使用ws对象替代ActiveSheet，避免因工作表切换导致的逻辑错误
4. 简化第一部分的条件分支，减少重复代码

内容的提问来源于stack exchange，提问作者jonathan Jonfan brandstrup