Question

我正在努力提高代码的速度。

我添加了一个计时器来确定我的代码运行所需的时间。每1000次迭代大约需要4.14次。

我已经阅读了一些关于写入阵列并将其读回来的帖子，但是如何在这里应用这个想法？也许，还有另一种方法。

Sub Random()

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False

    Dim wksData As Worksheet
    Dim StartTime As Double
    Dim SecondsElapsed As Double
    Dim x As Double
    Dim i As Double    

    Set wksData = Sheets("Data")
    wksData.Range("O3:P1048576").ClearContents             
    StartTime = Timer
    With wksData
        For x = 3 To 1002
            For j = 3 To 161
                .Range("O" & j) = Rnd()  
            Next j
            wksData.Calculate
            .Range("P" & x) = .Range("N1")
        Next x
    End With
    SecondsElapsed = Round(Timer - StartTime, 2)
    MsgBox "Macro ran successfully in " & SecondsElapsed & " seconds", vbInformation

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = True

End Sub

N1总结了工作表中公式的成本。每次生成一系列随机数时，我都会花费这些费用。

Answer 1

在内循环中实现数组解决方案后，速度提高了10倍（至少在我的简化测试文件中）。

Sub Random()

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False

    Dim wksData As Worksheet
    Dim StartTime As Double
    Dim SecondsElapsed As Double
    Dim x As Integer
    Dim j As Byte
    Dim ar As Variant

        Set wksData = Sheets("Data")
        wksData.Range("O3:P1048576").ClearContents
        StartTime = Timer
            With wksData
                For x = 3 To 1002
                    ReDim ar(1 To 159, 1 To 1)
                    For j = 1 To UBound(ar, 1)
                        ar(j, 1) = Rnd()
                    Next
                    .Range("O3").Resize(UBound(ar, 1)).Value = ar
                    wksData.Calculate
                    Erase ar
                    .Range("P" & x) = .Range("N1")
                Next 'x
            End With
        SecondsElapsed = Round(Timer - StartTime, 2)
        MsgBox "Macro ran successfully in " & SecondsElapsed & " seconds", vbInformation

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = True

End Sub

他们想要实现数组的关键思想是减少VBE和工作表之间的转换次数。在之前的代码中，您必须转到工作表，以便在每次迭代中将数据写入单元格。现在，您对数组中的值Rnd()执行操作表中未存储的值，直到完成为止。完成后，转到工作表并输出结果！

其他变化非常小。我将Double替换为Integer和Byte，因为它们需要更少的内存。另外，在For ... Next中我在Next之后删除了重复变量。毫无意义，编译器知道它在哪个循环中。

Answer 2

你可以使用一个易失性函数并完全摆脱内部循环，这会让你从157,842次迭代到999次开始：

With wksData
    .Range("O3:O161").Formula = "=RAND()"
    For x = 3 To 1002 
        .Calculate
        .Range("P" & x) = .Range("N1")
    Next x
End With

Answer 3

删除此行：

           wksData.Calculate

您已经解决了将Calculation设置为手动的问题，然后无论如何都会在每个循环上重新计算。

替代选项：

在工作表中，设置P3 =$N$1，然后将P3复制到P1002。

在您的代码中，删除For x = 3 to 1002循环。

Answer 4

感谢您的所有回复。以下是我最终确定的代码。对于1,000,000个随机场景（从最初的48分钟开始），它以284.61秒或仅超过4.5分钟运行。我测试了阵列解决方案，该解决方案在少数随机场景中运行得相当快，但在测试1,000,000时实际上速度较慢（不确定原因）。

Sub Random()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.DisplayAlerts = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

Dim wksData As Worksheet
Dim StartTime As Double
Dim SecondsElapsed As Double
Dim x As Long

    Set wksData = Sheets("Data")
    wksData.Range("N3:O1048576").ClearContents
    StartTime = Timer

        With wksData
            For x = 3 To 1000002
                .Range("N3:N161").Formula = "=Rand()"
                .Range("M1:M161").Calculate
                .Range("O" & x) = .Range("M1")
            Next
            wksData.Range("N3:N161").Copy
            wksData.Range("N3:N161").PasteSpecial xlPasteValues
            wksData.Calculate
        End With

    SecondsElapsed = Round(Timer - StartTime, 2)
    MsgBox "Macro ran successfully in " & SecondsElapsed & " seconds", vbInformation

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.DisplayAlerts = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True

End Sub

提高生成随机数的嵌套循环的速度

4 个答案: