[英]I am looking for a faster way to loop through over 150,000 rows
I am currently attempting optimise a set of 4 variables which can have any value between 0.01 and 0.97, the total of these 4 variables must equal 1. Eventually these 4 variables will need to be entered into the spreadsheet in order to return an output (this is a cell in the spreadsheet), ideally I would like to store this output against the 4 inputted variables.我目前正在尝试优化一组 4 个变量,它们的值可以介于 0.01 和 0.97 之间,这 4 个变量的总和必须等于 1。最终需要将这 4 个变量输入到电子表格中才能返回 output(这是电子表格中的一个单元格),理想情况下我想将这个 output 存储在 4 个输入变量中。
My first step was to attempt to find all the combinations possible;我的第一步是尝试找到所有可能的组合。 I did this in a very basic form which took over an hour and returned around 150,000 rows.我以非常基本的形式完成了此操作,耗时一个多小时并返回了大约 150,000 行。 Next I attempted to store the variables in a class before adding them to a collection but this was still quite slow.接下来,我尝试将变量存储在 class 中,然后再将它们添加到集合中,但这仍然很慢。 My next step was to add them into a multi dimensional array but this was just as slow as the collection method.我的下一步是将它们添加到多维数组中,但这与收集方法一样慢。 I have already added Application.ScreenUpdating = False
and found that Application.Calculation = xlManual
made no difference in this case.我已经添加了Application.ScreenUpdating = False
并发现Application.Calculation = xlManual
在这种情况下没有任何区别。
Does anyone have any advice on how to make this quicker?有没有人对如何使这个更快有任何建议?
This would need to be repeated a fair amount so ideally wouldn't take an hour to produce all the combinations.这需要大量重复,因此理想情况下不需要一个小时来产生所有组合。 I haven't included the part about getting an output as the first step is way too slow and storing those results will use the same process as getting the combinations.我没有包括关于获取 output 的部分,因为第一步太慢了,存储这些结果将使用与获取组合相同的过程。 I added the secondselapsed after the 3rd next as this takes about 32 seconds and is easier to test with.我在第三次下一个之后添加了 secondselapsed,因为这大约需要 32 秒并且更容易测试。
My code example using arrays is here:我使用 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
As an test, I used a Collection
to capture all of the combinations to add up to your target value and then stored all those combinations on a worksheet.作为测试,我使用Collection
来捕获所有组合以添加到您的目标值,然后将所有这些组合存储在工作表中。 It didn't take anywhere near an hour.用了不到一个小时。
You don't need GoTo
and you don't need to disable ScreenUpdating
.您不需要GoTo
也不需要禁用ScreenUpdating
。 But you should always use Option Explicit
(read this explanation for why).但是您应该始终使用Option Explicit
(请阅读此解释了解原因)。
The combination loop test is simple:组合循环测试很简单:
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
I used a high-performance timer in a separate module to measure the timing.我在一个单独的模块中使用了一个高性能计时器来测量时间。 On my system the results were在我的系统上,结果是
calc time elapsed = 1.774 seconds
number of combos = 156849
results to sheet1 time elapsed = 3.394 minutes
The timer code module is定时器代码模块是
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.