问题
I am looking for the quickest way to look up the value in worksheet data and give the corresponding value in another column. The lookup must be done in VBA. Only 1 lookup is to be performed (no more lookups are to be done on the same dataset).
For instance, we have data in this form:
Using VBA, what is the fastest way to find a value in the column B which corresponds to the value "key990000" in the column A?
回答1:
I have tested several different functions in contexts of sorted and unsorted data, 100k and 1 million rows of data.
The fastest way is to use WorksheetFunction.Vlookup or a combination of WorksheetFunction.Index and WorksheetFunction.Match. But in case 2 or more searches are to be done on the same column, then it's best to load data into array (which takes relatively more time) and loop through it (looping through a loaded array is extremely quick).
The summary results of performance tests (having both, 100 000 and 1 million rows of data)
| 100k rows | 1m rows |
---------------------------------------------
Sub | sort | uns | sort | uns |
---------------------------------------------
WsF_vlookup | 0.05 | 0.05 | 0.25 | 0.38 |
WsF_idx_match | 0.05 | 0.05 | 0.25 | 0.38 |
loop_in_array | 0.06 | 0.06 | 0.35 | 0.43 | - this is better for 2+ lookups
range_find | 0.10 | 0.12 | 0.80 | 0.95 |
match_in_array | 0.11 | 0.11 | 0.65 | 0.80 |
loop_in_sheet | 0.14 | 0.16 | 1.2 | 1.39 |
array_to_dict | 0.5 | 0.65 | 61 | 87 |
sheet_to_dict | 1.5 | 1.70 | 75 | 100 |
---------------------------------------------
Used subroutines
Sub WsF_vlookup()
Dim timer0 As Single
timer0 = Timer()
Debug.Print Application.WorksheetFunction.VLookup("key990000", ThisWorkbook.Worksheets("Sheet1").Range("A1:B1000000"), 2, 0)
Debug.Print Timer - timer0
End Sub
Sub WsF_idx_match()
Dim timer0 As Single
Dim rw As Long
timer0 = Timer()
rw = Application.WorksheetFunction.Match("key990000", ThisWorkbook.Worksheets("Sheet1").Range("A1:A1000000"), 0)
Debug.Print Application.WorksheetFunction.Index(ThisWorkbook.Worksheets("Sheet1").Range("B1:B1000000"), rw)
'no difference from:
'Debug.Print ThisWorkbook.Worksheets("Sheet1").Cells(rw, 2)
Debug.Print Timer - timer0
End Sub
Sub loop_in_array()
Dim timer0 As Single
Dim myArray1() As Variant
Dim i As Long
timer0 = Timer()
'Reading rows takes the majority of time
myArray1 = ThisWorkbook.Worksheets("Sheet1").Range("A1:A1000000").Value
'For 1m unsorted rows the following part takes only 0.06s when the key is near the end
For i = 1 To UBound(myArray1, 1)
If myArray1(i, 1) = "key990000" Then
Debug.Print ThisWorkbook.Worksheets("Sheet1").Cells(i, 2).Value
Exit For
End If
Next
Debug.Print Timer - timer0
End Sub
Sub range_find()
Dim timer0 As Single
Dim rngFound As Range
timer0 = Timer()
Set rngFound = ThisWorkbook.Worksheets("Sheet1").Range("A1:A1000000").Find("key990000", , xlValues, xlWhole)
Debug.Print rngFound.Offset(0, 1).Value
Debug.Print Timer - timer0
End Sub
Sub match_in_array()
Dim timer0 As Single
Dim myArray1() As Variant
Dim lngRow As Long
timer0 = Timer()
'Reading rows takes half of the time
myArray1 = ThisWorkbook.Worksheets("Sheet1").Range("A1:A1000000").Value
'For 1m unsorted rows the following part takes 0.45s when the key is near the end
lngRow = Application.WorksheetFunction.Match("key990000", myArray1, 0)
Debug.Print ThisWorkbook.Worksheets("Sheet1").Cells(lngRow, 2)
Debug.Print Timer - timer0
End Sub
Sub loop_in_sheet()
Dim timer0 As Single
Dim i As Long
Dim cell As Range
timer0 = Timer()
For Each cell In ThisWorkbook.Worksheets("Sheet1").Range("A1:A1000000")
If cell.Value = "key990000" Then
Debug.Print ThisWorkbook.Worksheets("Sheet1").Range("B" & cell.Row).Value
Exit For
End If
Next
Debug.Print Timer - timer0
End Sub
Sub array_to_dict()
Dim timer0 As Single
Dim myArray1() As Variant
Dim dict As Object
Dim i As Long
timer0 = Timer()
myArray1 = ThisWorkbook.Worksheets("Sheet1").Range("A1:B1000000").Value
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(myArray1, 1)
dict(myArray1(i, 1)) = myArray1(i, 2)
Next
Debug.Print dict("key990000")
Debug.Print Timer - timer0
Set dict = Nothing
End Sub
Sub sheet_to_dict()
Dim timer0 As Single
Dim dict As Object
Dim cell As Range
timer0 = Timer()
Set dict = CreateObject("Scripting.Dictionary")
For Each cell In ThisWorkbook.Worksheets("Sheet1").Range("A1:A1000000")
dict(cell.Value) = ThisWorkbook.Worksheets("Sheet1").Range("B" & cell.Row).Value
Next
Debug.Print dict("key990000")
Debug.Print Timer - timer0
Set dict = Nothing
End Sub
来源：https://stackoverflow.com/questions/48322557/fastest-vlookup-in-worksheet-data-performed-in-vba