如何加速Excel VBA中Cells.EntireColumn.AutoFit的执行速度？

问题根源 #

手动双击列宽时，Excel只会分析你选中的有数据的有效区域来计算合适宽度；但Cells.EntireColumn.AutoFit会遍历每一列的所有行（包括表格下方的空白行），这在有大量空白行的表格里会产生不必要的计算，直接导致耗时暴涨。

优化方案 #

1. 只对实际数据区域执行AutoFit

放弃遍历整列，先定位表格的真实数据范围，再对这个范围的列执行AutoFit，大幅减少计算量：

' 定位数据区域的最后一行和最后一列
Dim lastRow As Long, lastCol As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column

' 对数据区域的列执行AutoFit
Range(Cells(1, 1), Cells(lastRow, lastCol)).EntireColumn.AutoFit

2. 关闭更多后台消耗功能

除了ScreenUpdating，关闭事件触发和自动计算，避免AutoFit过程中额外的资源消耗：

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

记得在代码结束时恢复这些设置：

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

3. 优化隐藏列的逻辑（可选）

虽然你说这部分耗时不大，但可以把需要隐藏的列批量处理，减少Excel的交互次数：

Dim hideCols As Range
Set hideCols = Nothing

For i = 3 To 167
    If Cells(RadekDatSkryti, i).Value = 0 Then
        If hideCols Is Nothing Then
            Set hideCols = Columns(i)
        Else
            Set hideCols = Union(hideCols, Columns(i))
        End If
    End If
Next i

' 批量隐藏列
If Not hideCols Is Nothing Then hideCols.EntireColumn.Hidden = True

修改后的完整代码 #

Sub Hromadne()
    ' 关闭后台消耗功能
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    Selection.AutoFilter Field:=1, Criteria1:="<>0"
    RadekDatSkryti = Sheets("Hromadné").Range("C3").Value
    Rows(RadekDatSkryti).EntireRow.Hidden = True
    
    ' 精准定位数据区域并执行AutoFit
    Dim lastRow As Long, lastCol As Long
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
    Range(Cells(1, 1), Cells(lastRow, lastCol)).EntireColumn.AutoFit
    
    ' 批量处理列隐藏
    Dim hideCols As Range, i As Integer
    Set hideCols = Nothing
    For i = 3 To 167
        If Cells(RadekDatSkryti, i).Value = 0 Then
            If hideCols Is Nothing Then
                Set hideCols = Columns(i)
            Else
                Set hideCols = Union(hideCols, Columns(i))
            End If
        End If
    Next i
    If Not hideCols Is Nothing Then hideCols.EntireColumn.Hidden = True
    
    ' 恢复后台功能
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
End Sub

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