Excel VBA按表头颜色隐藏/取消隐藏列耗时过长，求优化方案

原代码的核心问题 #

• 遍历了整列所有单元格（A:AT），但实际只需要检查表头行的单元格颜色，完全没必要遍历几十万行数据
• 每次操作列时Excel会自动刷新屏幕，频繁刷新大幅拖慢执行速度
• 取消隐藏的代码和隐藏代码重名（都叫HideColumnIfRed），会导致执行错误，需先修正命名问题

优化后的代码 #

隐藏红色表头列

Sub HideRedHeaderColumns()
    Dim headerCell As Range
    Dim targetRange As Range
    
    ' 只遍历表头行（假设表头在第1行，可根据实际修改行号）
    Set targetRange = ThisWorkbook.ActiveSheet.Range("A1:AT1")
    
    ' 关闭屏幕刷新、事件触发，大幅提升速度
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    For Each headerCell In targetRange
        If headerCell.Interior.Color = vbRed Then
            headerCell.EntireColumn.Hidden = True
        End If
    Next headerCell
    
    ' 恢复屏幕刷新和事件触发
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

取消隐藏红色表头列

Sub UnhideRedHeaderColumns()
    Dim headerCell As Range
    Dim targetRange As Range
    
    ' 只遍历表头行（假设表头在第1行，可根据实际修改行号）
    Set targetRange = ThisWorkbook.ActiveSheet.Range("A1:AT1")
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    For Each headerCell In targetRange
        If headerCell.Interior.Color = vbRed Then
            headerCell.EntireColumn.Hidden = False
        End If
    Next headerCell
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

极致优化方案（合并列操作） #

如果需要进一步提速，可以把所有符合条件的列合并成一个范围，一次性完成隐藏/取消隐藏操作：

Sub HideRedHeaderColumns_Fastest()
    Dim headerCell As Range
    Dim targetRange As Range
    Dim columnsToHide As Range
    
    Set targetRange = ThisWorkbook.ActiveSheet.Range("A1:AT1")
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    For Each headerCell In targetRange
        If headerCell.Interior.Color = vbRed Then
            If columnsToHide Is Nothing Then
                Set columnsToHide = headerCell.EntireColumn
            Else
                Set columnsToHide = Union(columnsToHide, headerCell.EntireColumn)
            End If
        End If
    Next headerCell
    
    ' 一次性隐藏所有目标列
    If Not columnsToHide Is Nothing Then columnsToHide.Hidden = True
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

注意事项 #

• 若表头不在第1行，将代码中的Range("A1:AT1")替换为实际的表头行范围，比如Range("A3:AT3")
• 操作完成后务必恢复ScreenUpdating和EnableEvents，避免影响Excel的正常使用

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