如何优化运行缓慢的Excel VBA月份隐藏/显示代码？

原代码的核心问题 #

1. 滥用Select/Selection操作，触发不必要的界面刷新，拖慢执行速度
2. 逐个单元格循环隐藏列，频繁的界面操作导致效率低下
3. 存在冗余代码（比如Range("D1:ABG1").Value = Range("D1:ABG1").Value完全无意义）
4. 未关闭Excel的后台交互功能（如屏幕更新、事件触发），额外消耗资源

优化措施 #

• 关闭屏幕更新、自动计算、事件触发等后台功能，减少执行过程中的界面开销
• 彻底移除Select/Selection，直接操作单元格和列对象
• 批量筛选需要隐藏的列，一次性执行隐藏操作，避免循环内重复触发界面更新
• 删除冗余代码，简化逻辑流程

优化后的代码 #

Sub jan1()
    Dim ws As Worksheet
    Dim targetRange As Range
    Dim hiddenColumns As Range
    
    ' 定义操作工作表，避免依赖ActiveSheet
    Set ws = ActiveWorkbook.ActiveSheet
    ' 限定目标范围为D1到ABG1，无需遍历整行
    Set targetRange = ws.Range("D1:ABG1")
    
    ' 关闭后台交互功能，提升速度
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    ' 复制D2:ABG2的值到D1:ABG1，直接赋值比复制粘贴更高效
    targetRange.Value = ws.Range("D2:ABG2").Value
    
    ' 设置字体格式，直接操作目标范围，无需Select
    With targetRange.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    
    ' 批量收集需要隐藏的列
    For Each cell In targetRange.Cells
        If cell.Value = "1" Then
            If hiddenColumns Is Nothing Then
                Set hiddenColumns = cell.EntireColumn
            Else
                Set hiddenColumns = Union(hiddenColumns, cell.EntireColumn)
            End If
        End If
    Next cell
    
    ' 一次性隐藏所有符合条件的列
    If Not hiddenColumns Is Nothing Then
        hiddenColumns.Hidden = True
    End If
    
    ' 恢复后台交互功能
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
    
    ' 可选：定位到C1，直接操作无需Select
    ws.Range("C1").Activate
End Sub

额外优化建议 #

• 如果"1"是数字而非文本，将cell.Value = "1"改为cell.Value = 1，避免类型转换开销
• 可以预先定义工作表（比如Set ws = ThisWorkbook.Sheets("Sheet1")），避免依赖ActiveSheet，提升代码稳定性

内容的提问来源于stack exchange，提问作者Célio Gonçalves