提高循环速度

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

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()数组中未存储在工作表中的值.完成后,转到工作表并输出结果!

其他变化非常小.我换成Doubles的Integer和Byte,因为它们需要较少的内存.另外,在For ... Next我摆脱了重复变量之后Next.毫无意义,编译器知道它在哪个循环中.