提高循环的速度

我正在尝试提高代码的速度。 我已经通过所有的基本技巧search了我的方式，并添加了一个计时器来帮助我确定我的代码运行需要多长时间。 每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 

Answer 1

你可以使用volatile函数，完全摆脱内部循环，从一开始的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 2

在内部循环中实现数组解决scheme后，速度提高了10倍（至less在我的简化testing文件中）。

 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 

他们为什么要实现数组的关键思想是减lessVBE和工作表之间的转换次数。 在你以前的代码中，你必须去工作表在每次迭代中将数据写入单元格。 现在，您可以对数组中的值进行Rnd() ，直到完成后才将其存储在工作表中。 完成后，转到工作表并输出结果！

其他变化是非常小的。 我用Integer和Bytereplace了Double ，因为它们需要更less的内存。 另外，在For ... Next我摆脱了下一个重复的variables。 没有意义，编译器知道它在哪个循环。

Answer 3

删除这一行：

  wksData.Calculate 

你已经将Calculation设置为手动的麻烦，然后你重新计算每个循环。

备选选项：

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

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

Answer 4

感谢您的所有答复。 以下是我最终确定的代码。 它运行了284.61秒，或者超过4.5分钟，运行了1,000,000个随机场景（从最初的48分钟开始）。 我testing了在less量随机场景下相当快速地工作的arrays解决scheme，但是当testing1,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