用于格式化 Excel 报告的 VBA 宏需要改进性能

Question

我有一个 VBA 宏，只要当前行中的级别列值不是前一行中的级别值的连续数字，它就会在 Excel 中插入一个空行，我使用的另一个条件是如果两个连续行中的级别相同，则跳过插入空白线。它可以很好地格式化我的 Excel 报告，但对于包含 4,50,000（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

我无法充分利用外部脚本或手动解决方案，因为我需要提供格式化报告作为最终输出，而无需任何后处理步骤。因此尝试使用宏来实现这一点。

任何提高此性能的建议都会非常有帮助。

Answer 1

• 使用数组一次转换数据并将输出写入工作表将提高效率 注意：测试前请备份文件。

Option Explicit

Sub Demo()
    Dim i As Long, j As Long, r As Long
    Dim arrData, arrRes, lastRow As Long, ColCnt As Long
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    arrData = Range("A7:F" & lastRow).Value
    ColCnt = UBound(arrData, 2)
    ReDim arrRes(1 To UBound(arrData) * 2, 1 To ColCnt)
    r = 1
    For j = 1 To ColCnt
        arrRes(r, j) = arrData(1, j)
    Next j
    For i = LBound(arrData) + 1 To UBound(arrData)
        If arrData(i, 1) = arrData(i - 1, 1) Or arrData(i, 1) = arrData(i - 1, 1) + 1 Then
            r = r + 1
        Else
            r = r + 2
        End If
        For j = 1 To ColCnt
            arrRes(r, j) = arrData(i, j)
        Next j
    Next i
    Range("A7").Resize(r, ColCnt).Value = arrRes
End Sub