多工作表批量隐藏/显示列的VBA事件处理代码问题求助

问题场景 #

工作簿包含6个工作表：

• 工作表1：控制页，A列是工作表2-5的表头名称，B1-B8设「隐藏/显示」下拉框
• 工作表2-5：需要根据控制页设置隐藏/显示指定列
• 工作表6：密钥表，禁止修改

原代码尝试用Worksheet_Change事件实现需求，但无论放在普通模块还是工作表专属代码中都未生效，且存在逻辑错误。

原问题代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim hideFtoJ As Boolean, hideKtoL As Boolean, hideMtoS As Boolean
    
    ' Check if the value of cell B1 has changed
    If Target.Address = "$B$1" Then
        ' Check the new value of cell B1
        If Target.Value = "HIDE" Then
            hideFtoJ = True
        ElseIf Target.Value = "SHOW" Then
            hideFtoJ = False
        End If
    End If
    
    ' Check if the value of cell B2 has changed
    If Target.Address = "$B$2" Then
        ' Check the new value of cell B2
        If Target.Value = "HIDE" Then
            hideKtoL = True
        ElseIf Target.Value = "SHOW" Then
            hideKtoL = False
        End If
    End If
    
    ' Check if the value of cell B3 has changed
    If Target.Address = "$B$3" Then
        ' Check the new value of cell B3
        If Target.Value = "HIDE" Then
            hideMtoS = True
        ElseIf Target.Value = "SHOW" Then
            hideMtoS = False
        End If
    End If
    
    ' Loop through all the worksheets in the workbook
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Sheet1" Then
            ' Hide or unhide columns F to J based on the value of B1
            If hideFtoJ = True Then
                ws.Range("F:J").EntireColumn.Hidden = True
            Else
                ws.Range("F:J").EntireColumn.Hidden = False
            End If
            
            ' Hide or unhide columns K to L based on the value of B2
            If hideKtoL = True Then
                ws.Range("K:L").EntireColumn.Hidden = True
            Else
                ws.Range("K:L").EntireColumn.Hidden = False
            End If
            
            ' Hide or unhide columns M to S based on the value of B3
            If hideMtoS = True Then
                ws.Range("M:S").EntireColumn.Hidden = True
            Else
                ws.Range("M:S").EntireColumn.Hidden = False
            End If
        End If
    Next ws
End Sub

修复后的代码（需放在Sheet1的代码模块中） #

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 限定只处理B1-B8区域的单个单元格变更
    If Intersect(Target, Me.Range("B1:B8")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    
    Dim ws As Worksheet
    Dim colRange As String
    Dim hideStatus As Boolean
    
    ' 根据变更的行，匹配对应的列范围（可根据A列表头扩展更多规则）
    Select Case Target.Row
        Case 1: colRange = "F:J"
        Case 2: colRange = "K:L"
        Case 3: colRange = "M:S"
        ' 以下可继续添加B4-B8对应的列范围
        ' Case 4: colRange = "T:V"
        ' ...
        Case Else: Exit Sub ' 不在规则内的行直接退出
    End Select
    
    ' 获取隐藏状态，兼容大小写输入
    hideStatus = (UCase(Target.Value) = "HIDE")
    
    ' 禁用事件，避免修改单元格时重复触发
    Application.EnableEvents = False
    
    ' 遍历目标工作表（仅Sheet2-Sheet5，排除Sheet1和密钥表Sheet6）
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Sheet1" And ws.Name <> "Sheet6" Then
            ws.Range(colRange).EntireColumn.Hidden = hideStatus
        End If
    Next ws
    
    ' 恢复事件触发
    Application.EnableEvents = True
End Sub

关键修复说明 #

1. 范围限定：通过Intersect判断变更单元格是否在B1-B8内，避免无关操作触发代码；同时限制仅处理单个单元格变更，防止批量修改出错。
2. 排除密钥表：明确跳过Sheet6，避免误修改保护表。
3. 事件禁用：添加Application.EnableEvents = False，防止代码执行时修改列状态触发循环事件。
4. 逻辑简化：直接通过Select Case映射行与列范围，用UCase兼容大小写输入，无需额外变量存储状态，减少逻辑错误。
5. 扩展性：可直接在Select Case中添加B4-B8对应的列范围规则，适配更多控制项。

使用注意事项 #

• 代码必须放在Sheet1的代码模块中（右键Sheet1→查看代码，粘贴进去），不能放在普通模块。
• 确保下拉框的选项为「HIDE」或「SHOW」（不区分大小写）。
• 若密钥表名称不是「Sheet6」，需修改代码中对应的判断条件。

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