我已经在排序和未排序数据、10万和100万行数据的上下文中测试了几个不同的函数。
最快的方法是使用WorksheetFunction.Vlookup或WorksheetFunction.Index和WorksheetFunction.Match的组合。但是如果要在同一列上进行2次或更多次搜索，那么最好将数据加载到数组中（这需要相对更多的时间）并循环它（循环加载的数组非常快）。

性能测试的汇总结果（具有100 000和1百万行数据）

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

在类似的情况下，我的代码必须多次在包含约20000个项目的列中搜索（唯一）字符串的行。我尝试了loop_in_array、WsF_idx_match和get_row_from_collection。
下面是对位于列最后一行的字符串进行10000次搜索的结果：

• loop_in_array在47125 ms内找到的字符串; 19815<
• 在13015 ms内通过匹配在工作表（WsF_idx_match）中找到的字符串; 19815<
  *47 ms在集合中搜索找到的字符串; 19815<

On Error Resume Next
  For idx = 1 To loopCnt
      myRow = 0                           ' = not found
      myRow = collFIDs(strID)
  Next idx

collFID是这样创建的：

Function buildColl_Feats_Rows() As Collection
  Dim collRet             As Collection
  Dim rowFID              As Long
  Dim lastRow             As Long
  Dim strFID              As String

      lastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).row
      Set collRet = New Collection

      On Error Resume Next

      For rowFID = 1 To lastRow
          strFID = ThisWorkbook.Worksheets("Sheet1").Cells(rowFID, 1).Value
          collRet.add CVar(rowFID), strFID
      Next rowFID

      Set buildColl_Feats_Rows = collRet
  End Function

...需要<200 ms（对于图纸中<20000行）