优化Excel格式VBA宏性能：45万行插入空行耗时过长

问题描述 #

我编写了一段VBA宏，用于在Excel报表中按规则插入空行：当A列（层级列）当前行数值与上一行数值不连续且不相等时插入空行；若连续行层级值相同或连续递增1则跳过。该宏功能正常，但处理45万行报表时耗时约18分钟，性能表现不佳。由于必须直接输出格式化后的报表，无法使用外部脚本或手动方案，附上当前代码寻求性能优化建议。

当前VBA代码 #

Sub test()

Dim i As Long
Dim a As Long
Dim x As Integer
Dim r As Range

a = Cells(Rows.Count, "A").End(xlUp).Row

'MsgBox a

For i = a To 6 Step -1

    'MsgBox i

    x = Cells(i, "A").Value - Cells(i - 1, "A").Value

   ' MsgBox x

    If Not (x = 0) And Not (x = 1) Then

    Rows(i).Resize(1).Insert

    End If

Next

End Sub

性能优化建议 #

• 关闭Excel后台开销项：宏执行前关闭屏幕刷新、自动计算和事件触发，完成后恢复，避免每一步操作都触发界面重绘和计算，这是提升VBA性能的基础操作。
• 用内存数组替代单元格直接访问：单元格IO是VBA的核心性能瓶颈，一次性将A列数据读取到内存数组中计算，避免循环中反复读写单元格。
• 批量插入空行：不要在循环里逐行插入，先收集所有需要插入的行号，再从大到小批量插入（避免行号偏移问题），大幅减少Excel的操作次数。
• 清理无用变量与优化类型：移除代码中未使用的变量（如原代码中的r As Range），将x的类型改为Long，避免大数值溢出风险。

优化后的示例代码 #

Sub OptimizedInsertRows()
    Dim lastRow As Long
    Dim arr() As Variant
    Dim insertRows As Collection
    Dim i As Long
    Dim diff As Long
    
    ' 关闭后台开销
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    ' 获取最后一行并读取A列数据到数组
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    arr = Range("A1:A" & lastRow).Value
    
    ' 收集需要插入的行号
    Set insertRows = New Collection
    For i = lastRow To 6 Step -1
        diff = arr(i, 1) - arr(i - 1, 1)
        If diff <> 0 And diff <> 1 Then
            insertRows.Add i
        End If
    Next i
    
    ' 批量插入空行
    For i = 1 To insertRows.Count
        Rows(insertRows(i)).Insert shift:=xlDown
    Next i
    
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

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