我正在尝试找到在VBA中执行任务的最快方法。目前我把它写成嵌套的for循环,这可能非常慢。我循环遍历一个唯一数字列表,并将它们与不同列表中的数字相匹配。如果我得到一个匹配,我将信息存储在一个多维数组中,因为可以有多个匹配,我想跟踪所有这些。不幸的是,这意味着当使用for循环时,如果只有1000个唯一数字和5000个数字来寻找匹配,我的循环最终会迭代1000 * 5000 = 5000000次。如您所见,这可能会很快造成问题。我问在VBA期间是否有更好的方法来解决这个问题。我已经完成了所有的技巧,例如将screenUpdating设置为false并计算到manaul。
这是我的代码:
For x = 0 To UBound(arrUniqueNumbers)
Dim arrInfo() As Variant
ReDim Preserve arrInfo(0)
If UBound(arrInfo) = 0 Then
arrInfo(0) = CStr(arrUniqueNumbers(x))
End If
For y = 2 To Length
UniqueString = CStr(arrUniquePhoneNumbers(x))
CLEARString = CStr(Sheets(2).Range("E" & y).Value)
If UniqueString = CLEARString Then 'match!
NormalizedDate = Format(CStr(Sheets(2).Range("G" & y).Value), "yyyymmdd")
z = z + 1
ReDim Preserve arrInfo(z)
arrInfo(z) = NormalizedDate & " " & LTrim(CStr(Sheets(2).Range("D" & y).Value))
arrInfo(z) = LTrim(arrInfo(z))
End If
Next
arrUniqueNumbers(x) = arrInfo()
ReDim arrInfo(0) 'erase everything in arrOwners
z = 0
Next
答案 0 :(得分:2)
循环效率非常低,因此存在相当多的可避免的瓶颈(大多数情况下最简单的变化为最复杂的变化)
UniqueString
步骤:此步骤不会随着更改y
而改变,所以重复它没有意义。Redim Preserve
:您正在最内层循环中重新分配内存,这是非常低效的。在循环外分配“足够”的内存量。Sheets().Range()
来访问单元格内容:每次访问电子表格时,都会发生巨大的拖累,并且会有很多与访问相关的开销。从电子表格中考虑一步获取操作,并将一步推送操作返回到电子表格中以获取结果。请参阅下面的示例代码。电子表格的高效获取和回推操作的示例代码:
Dim VarInput() As Variant
Dim Rng As Range
' Set Rng = whatever range you are looking at, say A1:A1000
VarInput = Rng
' This makes VarInput a 1 x 1000 array where VarInput(1,1) refers to the value in cell A1, etc.
' This is a ONE STEP fetch operation
' Your code goes here, loops and all
Dim OutputVar() as Variant
Redim OutputVar(1 to 1000, 1 to 1)
' Fill values in OutputVar(1,1), (1,2) etc. the way you would like in your output range
Dim OutputRng as Range
Set OutputRng = ActiveSheet.Range("B1:B1000")
' where you want your results
OutputRng = OutputVar
' ONE STEP push operation - pushes all the contents of the variant array onto the spreadsheet
还有很多其他步骤可以进一步显着加快您的代码速度,但这些步骤应该产生明显的影响而不需要太多努力。
答案 1 :(得分:0)
dim dict as Object
set dict = CreateObject("Scripting.Dictionary")
dim x as Long
'Fill with ids
'Are arrUniqueNumbers and arrUniquePhoneNumbers the same?
For x = 0 To UBound(arrUniqueNumbers)
dict.add CStr(arrUniquePhoneNumbers(x)), New Collection
next
'Load Range contents in 2-Dimensional Array
dim idArray as Variant
idArray = Sheets(2).Cells(2,"E").resize(Length-2+1).Value
dim timeArray as Variant
timeArray = Sheets(2).Cells(2,"G").resize(Length-2+1).Value
dim somethingArray as Variant
somethingArray = Sheets(2).Cells(2,"D").resize(Length-2+1).Value
dim y as Long
'Add Values to Dictionary
For y = 2 To Length
Dim CLEARString As String
CLEARString = CStr(timeArray(y,1))
If dict.exists(CLEARString) then
dict(CLEARString).Add LTrim( Format(timeArray(y,1)), "yyyymmdd")) _
& " " & LTrim(CStr(somethingArray(y,1)))
end if
next
像这样访问
dim currentId as Variant
for each currentId in dict.Keys
dim currentValue as variant
for each currentValue in dict(currentId)
debug.Print currentId, currentValue
next
next