arrays - 我正在寻找一种更快的方法来遍历超过 150,000 行
问题描述
我目前正在尝试优化一组 4 个变量,它们的值可以在 0.01 和 0.97 之间,这 4 个变量的总和必须等于 1。最终需要将这 4 个变量输入到电子表格中才能返回输出(这是电子表格中的一个单元格),理想情况下我想将此输出存储在 4 个输入变量中。
我的第一步是尝试找到所有可能的组合。我以非常基本的形式完成了此操作,耗时一个多小时并返回了大约 150,000 行。接下来,我尝试在将变量添加到集合之前将它们存储在一个类中,但这仍然很慢。我的下一步是将它们添加到多维数组中,但这与收集方法一样慢。我已经添加Application.ScreenUpdating = False
并发现在Application.Calculation = xlManual
这种情况下没有任何区别。
有没有人对如何使这个更快有任何建议?
这需要大量重复,因此理想情况下不需要一个小时来产生所有组合。我没有包括关于获取输出的部分,因为第一步太慢了,存储这些结果将使用与获取组合相同的过程。我在第三次下一个之后添加了 secondselapsed,因为这大约需要 32 秒并且更容易测试。
我使用数组的代码示例在这里:
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
解决方案
作为测试,我使用 aCollection
来捕获所有组合以添加到您的目标值,然后将所有这些组合存储在工作表中。用了不到一个小时。
您不需要也不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
推荐阅读
- javascript - 圆形上的 SVG textPath 看起来像 Edge 上的螺旋形?
- ios - 在 UICollectionView 中设置排序属性的问题
- javascript - Socket.io 不使用 socket.on 添加消息
- powershell - 从数组填充的 Powershell CSV 列
- php - PHPMailer 不在我的服务器上工作,但在另一台服务器上工作正常
- c# - 如何将WPF按钮文本水平居中对齐?
- php - 错误:无法修改标头信息 - 标头已由
- kubernetes - 如何使用 Traefik 从我的 Web apollo-client 暴露的应用程序访问 Apollo 服务器内部 Kubernetes 服务
- sql - 加入错误:无法绑定多部分标识符
- javascript - 范围问题 - 基于类的控制器中的嵌套 $mdDialog