作为测试,我使用Collection 来捕获所有组合以加起来达到您的目标值,然后将所有这些组合存储在工作表中。不到一个小时。
您不需要GoTo,也不需要禁用ScreenUpdating。但是您应该始终使用Option Explicit(请阅读this explanation 了解原因)。
组合循环测试很简单:
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