我構建了一個 VBA Sub，它將輸入字串與大型陣列中的等效字串匹配，并回傳一個特定字串，該字串系結到匹配的字串。
然而，雖然代碼在大約 100 個條目上運行良好，但大約需要 12 秒。大約 1000 個條目需要 1 分鐘，1500 個條目可能需要 3 分鐘。
所以，我想知道是否有什么可以改進的，以使代碼在大量條目時運行得更快。
VBA 函式：
Sub searchISIN()
Dim StartTime As Double
StartTime = Timer
lRow = getlastrow(ws_universe, 1)
Dim rngISIN As Range: Set rngISIN = ws_universe.Range("A2:A" & lRow)
Dim z As Long: z = 1
Dim i As Long: i = 1
Dim j As Long
For Each cell In rngISIN
z = z 1
For j = LBound(MatchingArr) To UBound(MatchingArr)
If InStr(1, CStr(MatchingArr(j)), CStr(cell.Value), vbTextCompare) Then
ws_universe.Cells(z, 2).Value = Left(MatchingArr(j), 18)
i = i 1
GoTo NextIteration
End If
Next j
ws_universe.Cells(z, 2).Value = "k.A."
i = i 1
NextIteration:
Next cell
MsgBox "Search ISINs: " & Format((Timer - StartTime) / 86400, "hh:mm:ss")
End Sub
被決議的陣列有大約 150k 個條目，每個條目都是一個字串，如下所示：
"IID00XXXXXXXXXXXX|Magna International Inc.|US55922PF576;US559222AQ72;CA559222AT14;US559222AV67;US55922PRV75;US55922PF329;CA5592224011;XS1689185426;US55922PUW12;US559222AR55"
該代碼采用輸入字串，例如 CA559222AT14，使用內置 InStr 函式并回傳當前陣列條目的前 18 個字符。在本例中，回傳值為“IID00XXXXXXXXXXXX”
I'm open for any idea to improve the code runtime. There are no constrains, rearranging the array layout, rearranging the complete code or whatsoever.
uj5u.com熱心網友回復：
回圈遍歷陣列而不是范圍
- 未測驗。
lRow如果小于 3 ，它將失敗。
Option Explicit
Sub searchISIN()
Dim StartTime As Double: StartTime = Timer
lRow = getlastrow(ws_universe, 1)
Dim rngISIN As Range: Set rngISIN = ws_universe.Range("A2:A" & lRow)
Dim aData As Variant: aData = rngISIN.Value
Dim bData As Variant: bData = rngISIN.EntireRow.Columns("B").Value
Dim aOffset As Long: aOffset = 1 - LBound(MatchingArr)
Dim aIndex As Variant
Dim a As Long
Dim i As Long: i = 1
For a = 1 To UBound(aData, 1)
aIndex = Application.Match("*" & CStr(aData(a, 1)) & "*", MatchingArr, 0)
If IsNumeric(aIndex) Then
bData(a, 1).Value = Left(MatchingArr(aIndex - aOffset), 18)
i = i 1
Else
bData(a, 1) = "k.A."
i = i 1
End If
Next a
rngISIN.EntireRow.Columns("B").Value = bData
MsgBox "Search ISINs: " & Format((Timer - StartTime) / 86400, "hh:mm:ss")
End Sub
Sub searchISINFirst()
Dim StartTime As Double: StartTime = Timer
lRow = getlastrow(ws_universe, 1)
Dim rngISIN As Range: Set rngISIN = ws_universe.Range("A2:A" & lRow)
Dim aData As Variant: aData = rngISIN.Value
Dim bData As Variant: bData = rngISIN.EntireRow.Columns("B").Value
Dim a As Long
Dim i As Long: i = 1
Dim j As Long
Dim jFound As Boolean
For a = 1 To UBound(aData, 1)
For j = LBound(MatchingArr) To UBound(MatchingArr)
If InStr(1, CStr(MatchingArr(j)), CStr(aData(a, 1)), vbTextCompare) Then
bData(a, 1).Value = Left(MatchingArr(j), 18)
i = i 1
jFound = True
Exit For
End If
Next j
If jFound Then
jFound = False
Else
bData(a, 1) = "k.A."
i = i 1
End If
Next a
rngISIN.EntireRow.Columns("B").Value = bData
MsgBox "Search ISINs: " & Format((Timer - StartTime) / 86400, "hh:mm:ss")
End Sub
uj5u.com熱心網友回復：
我認為您正在做的是
1,048,576使用行的第一次運行的結果是00:00:56使用以下代碼：
Dim myDict As New Dictionary
Sub TestBigRange()
Dim StartTime As Double
StartTime = Timer
Dim rangeArr() As Variant
rangeArr = Range("A1:A1048576")
Dim x As Long
'Build dictionary if needed
If myDict.Count = 0 Then
For x = LBound(rangeArr, 1) To UBound(rangeArr, 1)
myDict.Add x, "A" & x
Next x
End If
Dim pasteRng() As Variant
pasteRng = rangeArr
For x = LBound(rangeArr, 1) To UBound(rangeArr, 1)
If myDict.Exists(rangeArr(x, 1)) Then pasteRng(x, 1) = myDict(rangeArr(x, 1))
Next x
Range("A1:A1048576") = rangeArr
Range("B1:B1048576") = pasteRng
MsgBox "Search Dictionary: " & Format((Timer - StartTime) / 86400, "hh:mm:ss")
End Sub
之后無需重建字典：
1,048,576用條目構建字典需要24 seconds.
從文本檔案讀取/寫入字典也非常快：
'If we write to separate lines, we don't have to split:
Sub WriteDictionary()
Open ThisWorkbook.Path & "\DictionaryFile.txt" For Output As #1
Dim x As Long
For x = 1 To 1048576
Print #1, x & ""
Print #1, "A" & x
Next x
Close #1
End Sub
Sub ReadDictionary()
Set myDict = New Dictionary
Dim StartTime As Double
StartTime = Timer
Open ThisWorkbook.Path & "\DictionaryFile.txt" For Input As #1
Dim key, val
Do Until EOF(1)
Line Input #1, key
Line Input #1, val
myDict.Add key, val
Loop
Close #1
MsgBox "Read Dictionary from File [1048576 rows]: " & Format((Timer - StartTime) / 86400, "hh:mm:ss")
End Sub
編輯：每蒂姆威廉姆斯，讓你的字典更小會導致更快的創建/查找時間。
在這里，我們對中的1048576行進行完整的構建字典/查找31 seconds！
Dim aDicts() As New Dictionary
Sub BuildDictionaries(ARange As Range, Optional MaxSize = 100000)
'100,000 is arbitrary, but seems to be a pretty good number
'Feel free to experiment: too small/big = slower.
ReDim aDicts(Int(ARange.Cells.Count / MaxSize))
Dim x As Long, r() As Variant, curDict As Integer
curDict = 0: r = ARange
For x = LBound(r, 1) To UBound(r, 1)
If aDicts(curDict).Count < MaxSize Then
aDicts(curDict).Add x, "A" & x
Else
curDict = curDict 1
aDicts(curDict).Add x, "A" & x
End If
Next x
End Sub
搜索每個字典的代碼：
For x = LBound(rangeArr, 1) To UBound(rangeArr, 1)
For Each z In aDicts
If z.Exists(rangeArr(x, 1)) Then
pasteRng(x, 1) = z(rangeArr(x, 1))
Exit For
End If
Next z
Next x
這是我上一輪測驗的輸出（從文本檔案中讀取字典）：
Need 10 dictionaries [100,000 split]
Dictionary(0) size: 100000
Dictionary(1) size: 100000
Dictionary(2) size: 100000
Dictionary(3) size: 100000
Dictionary(4) size: 100000
Dictionary(5) size: 100000
Dictionary(6) size: 100000
Dictionary(7) size: 100000
Dictionary(8) size: 100000
Dictionary(9) size: 100000
Dictionary(10) size: 48576
Read Dictionary from File [1048576 rows]: 00:00:02
Search Dictionary [100000]: 00:00:02
Search Dictionary [200000]: 00:00:03
Search Dictionary [300000]: 00:00:04
Search Dictionary [400000]: 00:00:05
Search Dictionary [500000]: 00:00:07
Search Dictionary [600000]: 00:00:10
Search Dictionary [700000]: 00:00:13
Search Dictionary [800000]: 00:00:17
Search Dictionary [900000]: 00:00:22
Search Dictionary [1000000]: 00:00:27
Search Dictionary [Finished]: 00:00:31
uj5u.com熱心網友回復：
如果您有大量資料，這不是一個答案，只是為了說明有關加載腳本字典的一點......
下圖比較了實際加載時間與條目數量，以及基于加載前 500k 條目的時間的線性推斷。很明顯，當您超過幾十萬個條目時，加載時間會變得很長。
如上所述，將資料拆分到多個字典（例如存盤在 Collection 中）可能會導致更快的運行時間（取決于您的確切用例）。
還值得注意的是，字典可以接受 [幾乎] 任何資料型別作為鍵，并且某些型別的加載速度比其他型別快（例如，Long鍵的添加速度比String鍵快 2-3 倍）
轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/439942.html
下一篇：在VBA中定義引數的最佳布局