我正在尋找一種更快的方法來遍歷超過 150,000 行

Question

我目前正在嘗試優化一組 4 個變量，它們的值可以介於 0.01 和 0.97 之間，這 4 個變量的總和必須等於 1。最終需要將這 4 個變量輸入到電子表格中才能返回 output（這是電子表格中的一個單元格），理想情況下我想將這個 output 存儲在 4 個輸入變量中。

我的第一步是嘗試找到所有可能的組合。 我以非常基本的形式完成了此操作，耗時一個多小時並返回了大約 150,000 行。 接下來，我嘗試將變量存儲在 class 中，然后再將它們添加到集合中，但這仍然很慢。 我的下一步是將它們添加到多維數組中，但這與收集方法一樣慢。 我已經添加了Application.ScreenUpdating = False並發現Application.Calculation = xlManual在這種情況下沒有任何區別。

有沒有人對如何使這個更快有任何建議？

這需要大量重復，因此理想情況下不需要一個小時來產生所有組合。 我沒有包括關於獲取 output 的部分，因為第一步太慢了，存儲這些結果將使用與獲取組合相同的過程。 我在第三次下一個之后添加了 secondselapsed，因為這大約需要 32 秒並且更容易測試。

我使用 arrays 的代碼示例在這里：

Sub WDLPerfA()
StartTime = Timer
Application.ScreenUpdating = False

NoRows = 0
Dim combos()
ReDim combos(NoRows, 1)

'Looping through variables
For a = 1 To 97
    For b = 1 To 97
        For c = 1 To 97
            For d = 1 To 97

Application.ScreenUpdating = False

Total = a + b + c + d

If Total = 100 Then

    If NoRows = 0 Then GoTo Line1
        ElseIf NoRows > 0 Then
        NoRows = NoRows + 1
        ReDim combos(NoRows, 1)

Line1:
combo = a & "," & b & "," & c & "," & d
combos(NoRows, 0) = combo

Else: GoTo Line2
End If

Line2:
Next
Next
Next
SecondsElapsed = Round(Timer - StartTime, 2)
Debug.Print SecondsElapsed
Next

End Sub

Answer 1

作為測試，我使用Collection來捕獲所有組合以添加到您的目標值，然后將所有這些組合存儲在工作表中。 用了不到一個小時。

您不需要GoTo也不需要禁用ScreenUpdating 。 但是您應該始終使用Option Explicit （請閱讀此解釋了解原因）。

組合循環測試很簡單：

Option Explicit

Sub FourCombos()
    Const MAX_COUNT As Long = 97
    Const TARGET_VALUE As Long = 100

    Dim combos As Collection
    Set combos = New Collection

    Dim a As Long
    Dim b As Long
    Dim c As Long
    Dim d As Long

    StartCounter
    For a = 1 To MAX_COUNT
        For b = 1 To MAX_COUNT
            For c = 1 To MAX_COUNT
                For d = 1 To MAX_COUNT
                    If (a + b + c + d = TARGET_VALUE) Then
                        combos.Add a & "," & b & "," & c & "," & d
                    End If
                Next d
            Next c
        Next b
    Next a

    Debug.Print "calc time elapsed = " & FormattedTimeElapsed()
    Debug.Print "number of combos  = " & combos.Count

    Dim results As Variant
    ReDim results(1 To combos.Count, 1 To 4)

    StartCounter
    For a = 1 To combos.Count
        Dim combo As Variant
        combo = Split(combos.Item(a), ",")
        results(a, 1) = combo(0)
        results(a, 2) = combo(1)
        results(a, 3) = combo(2)
        results(a, 4) = combo(3)
    Next a
    Sheet1.Range("A1").Resize(combos.Count, 4).Value = results
    Debug.Print "results to sheet1 time elapsed = " & FormattedTimeElapsed()

End Sub

我在一個單獨的模塊中使用了一個高性能計時器來測量時間。 在我的系統上，結果是

calc time elapsed = 1.774 seconds
number of combos  = 156849
results to sheet1 time elapsed = 3.394 minutes

定時器代碼模塊是

Option Explicit

'------------------------------------------------------------------------------
' For Precision Counter methods
'
Private Type LargeInteger
    lowpart As Long
    highpart As Long
End Type

Private Declare Function QueryPerformanceCounter Lib _
                         "kernel32" (lpPerformanceCount As LargeInteger) As Long
Private Declare Function QueryPerformanceFrequency Lib _
                         "kernel32" (lpFrequency As LargeInteger) As Long

Private counterStart As LargeInteger
Private counterEnd As LargeInteger
Private crFrequency As Double

Private Const TWO_32 = 4294967296#               ' = 256# * 256# * 256# * 256#

'==============================================================================
' Precision Timer Controls
' from: https://stackoverflow.com/a/198702/4717755
'
Private Function LI2Double(lgInt As LargeInteger) As Double
    '--- converts LARGE_INTEGER to Double
    Dim low As Double
    low = lgInt.lowpart
    If low < 0 Then
        low = low + TWO_32
    End If
    LI2Double = lgInt.highpart * TWO_32 + low
End Function

Public Sub StartCounter()
    '--- Captures the high precision counter value to use as a starting
    '    reference time.
    Dim perfFrequency As LargeInteger
    QueryPerformanceFrequency perfFrequency
    crFrequency = LI2Double(perfFrequency)
    QueryPerformanceCounter counterStart
End Sub

Public Function TimeElapsed() As Double
    '--- Returns the time elapsed since the call to StartCounter in microseconds
    If crFrequency = 0# Then
        Err.Raise Number:=11, _
                  Description:="Must call 'StartCounter' in order to avoid " & _
                                "divide by zero errors."
    End If
    Dim crStart As Double
    Dim crStop As Double
    QueryPerformanceCounter counterEnd
    crStart = LI2Double(counterStart)
    crStop = LI2Double(counterEnd)
    TimeElapsed = 1000# * (crStop - crStart) / crFrequency
End Function

Public Function FormattedTimeElapsed() As String
    '--- returns the elapsed time value as above, but in a nicely formatted
    '    string in seconds, minutes, or hours
    Dim result As String
    Dim elapsed As Double
    elapsed = TimeElapsed()
    If elapsed <= 1000 Then
        result = Format(elapsed, "0.000") & " microseconds"
    ElseIf (elapsed > 1000) And (elapsed <= 60000) Then
        result = Format(elapsed / 1000, "0.000") & " seconds"
    ElseIf (elapsed > 60000) And (elapsed < 3600000) Then
        result = Format(elapsed / 60000, "0.000") & " minutes"
    Else
        result = Format(elapsed / 3600000, "0.000") & " hours"
    End If
    FormattedTimeElapsed = result
End Function