如何优化VBA代码实现基于单元格值的行和工作表显隐控制？

我有一个包含大量工作表的工作簿。Sheet1上有30个“区块”，每个区块里有一个单元格（比如B31），值为“Yes”或“No”。当值为“Yes”时，需要显示Sheet1的指定后续15行、Sheet2的指定行，以及对应的工作表（Sheet3至Sheet30）；值为“No”则隐藏这些内容。目前功能已实现，但代码重复度极高，新增区块维护困难，运行时还会出现黑屏卡顿。现有代码是三个区块的重复实现，示例如下：

Dim ScopeChange As Range
Dim Module_1 As Variant
Dim Module_2 As Variant
Dim Module_3 As Variant

Module_1 = Range("B31").Value
Module_2 = Range("B49").Value
Module_3 = Range("B67").Value

Set ScopeChange = Range("B31")
If Not ScopeChange Is Nothing Then
    Application.EnableEvents = False
    Select Case Module_1
        Case "Yes": Rows("32:46").EntireRow.Hidden = False
                    Worksheets("Sheet2").Rows("19:36").EntireRow.Hidden = False
                    Worksheets("Sheet3").Visible = True
        Case "No": Rows("32:46").EntireRow.Hidden = True
                    Worksheets("Sheet2").Rows("19:36").EntireRow.Hidden = True
                    Worksheets("Sheet3").Visible = False
    End Select
    Application.EnableEvents = True
End If

Set ScopeChange = Range("B49")
If Not ScopeChange Is Nothing Then
    Application.EnableEvents = False
    Select Case Module_2
        Case "Yes": Rows("50:64").EntireRow.Hidden = False
                    Worksheets("Sheet2").Rows("37:54").EntireRow.Hidden = False
                    Worksheets("Sheet4").Visible = True
        Case "No": Rows("50:64").EntireRow.Hidden = True
                    Worksheets("Sheet2").Rows("37:54").EntireRow.Hidden = True
                    Worksheets("Sheet4").Visible = False
    End Select
    Application.EnableEvents = True
End If

Set ScopeChange = Range("B67")
If Not ScopeChange Is Nothing Then
    Application.EnableEvents = False
    Select Case Module_3
        Case "Yes": Rows("68:82").EntireRow.Hidden = False
                    Worksheets("Sheet2").Rows("55:72").EntireRow.Hidden = False
                    Worksheets("Sheet5").Visible = True
        Case "No": Rows("68:82").EntireRow.Hidden = True
                    Worksheets("Sheet2").Rows("55:72").EntireRow.Hidden = True
                    Worksheets("Sheet5").Visible = False
    End Select
    Application.EnableEvents = True
End If

End Sub

1. 抽象配置数据，消除代码重复 #

将每个区块的控制参数（触发单元格地址、Sheet1行范围、Sheet2行范围、关联工作表名）整理成配置数组，通过循环统一处理所有区块，避免重复编写相同逻辑。

2. 优化性能，解决卡顿问题 #

• 仅在代码首尾各设置一次Application.EnableEvents，避免频繁开关
• 关闭界面刷新和自动计算，减少Excel后台开销，执行完成后恢复默认设置
• 提前定义工作表对象，避免重复查找工作表的性能损耗

Sub ToggleBlocks()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim configs As Variant
    Dim i As Integer
    Dim triggerVal As String
    Dim isVisible As Boolean
    
    ' 提前定义工作表对象，减少重复查找开销
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")
    
    ' 配置数组：每个元素对应一个区块，格式为[触发单元格地址, Sheet1行范围, Sheet2行范围, 关联工作表名]
    configs = Array( _
        Array("B31", "32:46", "19:36", "Sheet3"), _
        Array("B49", "50:64", "37:54", "Sheet4"), _
        Array("B67", "68:82", "55:72", "Sheet5"), _
        ' 新增区块只需在这里添加对应配置行即可
        Array("BXX", "YY:ZZ", "AA:BB", "SheetN") _
    )
    
    ' 关闭不必要的系统事件和界面刷新，提升运行速度
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    
    ' 循环处理所有区块配置
    For i = LBound(configs) To UBound(configs)
        triggerVal = ws1.Range(configs(i)(0)).Value
        isVisible = (UCase(triggerVal) = "YES") ' 兼容大小写输入
        
        ' 控制Sheet1行显隐
        ws1.Rows(configs(i)(1)).EntireRow.Hidden = Not isVisible
        ' 控制Sheet2行显隐
        ws2.Rows(configs(i)(2)).EntireRow.Hidden = Not isVisible
        ' 控制关联工作表显隐
        ThisWorkbook.Worksheets(configs(i)(3)).Visible = isVisible
    Next i
    
    ' 恢复系统默认设置
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
    
    ' 释放对象变量
    Set ws1 = Nothing
    Set ws2 = Nothing
End Sub

优化说明 #

• 可复用性：新增区块仅需在configs数组中添加一行配置，无需修改核心逻辑，维护成本大幅降低
• 性能提升：通过批量关闭界面刷新、事件和自动计算，彻底解决运行时黑屏卡顿问题
• 鲁棒性：使用UCase(triggerVal)避免大小写敏感问题，提前定义工作表对象减少重复查找的性能损耗

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