在VBA中执行的工作表数据中最快的VLOOKUP

Question

我正在寻找最快的方法来查找工作表数据中的值，并在另一列中给出相应的值。查找必须在VBA中完成。只执行1次查找（不再对同一数据集进行查找）。

例如，我们有以这种形式的数据：

使用VBA，在列B中找到与A列中的值“key990000”对应的值的最快方法是什么？

Answer 1

我已经在排序和未排序数据，100k和100万行数据的上下文中测试了几个不同的函数。

最快的方法是使用WorksheetFunction.Vlookup或WorksheetFunction.Index和WorksheetFunction.Match的组合。但是如果要在同一列上进行2次或更多次搜索，那么最好将数据加载到数组中（这需要相对更多的时间）并循环遍历它（循环加载数组非常快）。

性能测试的摘要结果（包含100 000和100万行数据）

                | 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  |
---------------------------------------------

使用的子程序

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 keyDict As Variant
  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 keyDict As Variant
  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