我正在寻找一种更快的方法来遍历超过 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