在VBA Excel中优化双循环的性能

Question

我很想知道在双循环中执行一组指令的最快方法，以循环遍历二维范围的单元格。 我的代码将是这样的：

Sub Test()

For i = 1 To 1000000
    For j = 1 To 10   'It can be more than 10
        'I put a set of instructions here
    Next j
Next i

End Sub

例如，假设我编写了一个简单的代码来实现以下任务：

Sub Test1()
T0 = Timer
For i = 1 To 1000000
    For j = 1 To 10
        Cells(i, j) = j + Rnd()
    Next j
Next i
InputBox "The runtime of this program is ", "Runtime", Timer - T0
End Sub

我在我的机器上运行了程序Test1 ，完成了179.6406秒。 由于我没有声明变量（i和j），因此Test1正在运行，这些变量默认为Variant类型。 然后我向Test1添加一行以将变量声明为Longs，因为VBA针对Longs进行了优化。 新程序Test2将我的机器上的运行时间降低到168.7539秒（快了大约11秒）。

为了提高Test2的性能，我关闭了Test2代码运行时不需要的Excel功能。

Sub Test3()
Dim i As Long, j As Long
T0 = Timer

ScreenUpdateState = Application.ScreenUpdating
StatusBarState = Application.DisplayStatusBar
CalcState = Application.Calculation
EventsState = Application.EnableEvents
DisplayPageBreakState = ActiveSheet.DisplayPageBreaks
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

For i = 1 To 1000000
    For j = 1 To 10
        Cells(i, j) = j + Rnd()
    Next j
Next i

Application.ScreenUpdating = ScreenUpdateState
Application.DisplayStatusBar = StatusBarState
Application.Calculation = CalcState
Application.EnableEvents = EventsState
ActiveSheet.DisplayPageBreaks = DisplayPageBreaksState

InputBox "The runtime of this program is ", "Runtime", Timer - T0
End Sub

上述方法有助于提高Test2的性能， Test3在96.13672秒内完成。 所以我想知道是否有更有效的方法来做到这一点。 任何人都可以提出更快的版本吗？ 如果可能，甚至避免双循环程序。

Answer 1

我使用了一个内部VBA数组 ，这在10秒内运行：

Sub QuickTest()
    Dim v(1 To 1000000, 1 To 10) As Double
    For i = 1 To 1000000
        For j = 1 To 10
            v(i, j) = j + Rnd
        Next j
    Next i

    Range("A1:J1000000") = v
End Sub

注意：

• 使用内部VBA数组可以避免多次“触摸”工作表
• 数组可以一步而不是循环传输到工作表单元格。

编辑＃1：

考虑这个续集：

Sub QuickTest2_The_Sequel()
    Dim i As Long, j As Long, m As Long, n As Long
    Range("K1") = Evaluate("Now()")

    m = 10
    n = 1000000

    ReDim v(1 To n, 1 To m) As Double
    For i = 1 To n
        For j = 1 To m
            v(i, j) = j + Rnd
        Next j
    Next i

    Range("A1:J" & n) = v
    Range("K2") = Evaluate("Now()")
End Sub

在这里，我们使用单元格K1和K2来记录开始和停止时间。 我们还使用ReDim而不是Dim来“极大化”限制：

Answer 2

Sub Checkthis()
    starttime = Format(Now(), "hh:mm:ss")
    Dim i, j As Long
    Dim a(1000000, 10) As Long
    For i = 1 To 1000000
        For j = 1 To 10
            a(i, j) = j + Rnd
        Next j
    Next i
    Range("A1:J1000000") = a
    endtime = Format(Now(), "hh:mm:ss")
    Elapsed = DateDiff("s", starttime, endtime)
    MsgBox ("Finished in " & Elapsed & " seconds")
End Sub

Answer 3

尝试以下代码，它检查E列中的最后一行，然后Loop停在那里。 您可以将“E”修改为您需要的任何列。

Sub Test3()

Dim i As Long, j As Long, LastRow As Long
T0 = Timer

' in case Column E allways has data for each row >> you can modify to your needed Column
LastRow = Cells(Rows.count, "E").End(xlUp).row

ScreenUpdateState = Application.ScreenUpdating
StatusBarState = Application.DisplayStatusBar
CalcState = Application.Calculation
EventsState = Application.EnableEvents
DisplayPageBreakState = ActiveSheet.DisplayPageBreaks
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

For i = 1 To LastRow
    For j = 1 To 10
        Cells(i, j) = j + Rnd()
    Next j
Next i

Application.ScreenUpdating = ScreenUpdateState
Application.DisplayStatusBar = StatusBarState
Application.Calculation = CalcState
Application.EnableEvents = EventsState
ActiveSheet.DisplayPageBreaks = DisplayPageBreaksState

InputBox "The runtime of this program is ", "Runtime", Timer - T0

End Sub