（10/17追記）
編集しました。
どうせSQLなので、複数列をマッチングできるようにしました。
これはvlookupではなかなかできないので、だいぶ有用なのではないでしょうか？

しかし未だ問題があって、検索範囲のキーに重複がある場合、
結果のデータ行が増えてしまいます。
今はエラーを返すようにしていますが、どうしたもんでしょうね。

どうせなら完全外部結合ができてもそれはそれで便利なようにも思います。

（↓元の文章）

ExcelのVlookup、5万行×5万行のVlookupとかになると、
結構待たされて、イライラします。

そこで高速Vlookupです。

こちらの高速vlookupを使うという手もあるのですが、
http://excel-ubara.com/excel3/EXCEL019.html

別解として、
Excelをデータベースと見なして、SQLでJoinするという手を作ってみました。
いくつか障害があったのでやや面倒なことになっていますが、知見として。

 'SQL的なVlookup(高速)
Public Sub VlookupSQL()

Dim SR As Range, SRad
Dim Key As Range, Keyad
Dim Target As Range
Dim arGetIndex
Dim strSel_Sum
Dim Buf1, Buf2, Buf3, Buf4, Mode

'キーの選択
If Selection.Rows.Count = Rows.Count Or Selection.Columns.Count > 1 Then
    MsgBox "キーは複数列・列全体は不可です。", vbExclamation
    End
End If
Set Key = Selection

'検索範囲の設定
On Error Resume Next
    Set Buf1 = Application.InputBox("検索範囲を選択して下さい。（列全体不可）", "検索範囲", Type:=8)
    If Buf1 Is Nothing Then
        MsgBox "キャンセルしました", vbInformation
        End
    End If
On Error GoTo 0
If Buf1.Rows.Count = Rows.Count Or Buf1.Areas.Count > 1 Then
    MsgBox "検索範囲は列全体は不可です。", vbExclamation
    End
End If
Set SR = Buf1
SR.Parent.Select

'取得列数（選択するパターン）
On Error Resume Next
    Set Buf2 = Application.InputBox("検索範囲の中で、取得する列のセルを選択して下さい。（複数OK）", Type:=8)
    If Buf2 Is Nothing Then
        MsgBox "キャンセルしました", vbInformation
        End
    End If
On Error GoTo 0
arGetIndex = Array()
icnt = 0
For Each hogearea In Buf2.Areas
    For Each hogecell In hogearea.Rows(1).Cells
        icnt = icnt + 1
        ReDim Preserve arGetIndex(icnt - 1)
        arGetIndex(icnt - 1) = hogecell.Column - SR.Columns(1).Column + 1
    Next
Next

'出力先の選択
Key.Parent.Select
Key(1).Select
On Error Resume Next
    Set Buf3 = Application.InputBox("出力先セルを選択して下さい。", "検索範囲", Type:=8)
    If Buf3 Is Nothing Then
        MsgBox "キャンセルしました", vbInformation
        End
    End If
On Error GoTo 0
Set Target = Key.Offset(, Buf3(1).Column - Key.Column)

'接続方法
'    Mode = Application.InputBox("接続方法を選択して下さい。1:部分外部,2:完全外部,3:内部", "接続方法", 1)
'    If Mode = 0 Then
'        MsgBox "キャンセルしました", vbInformation
'        End
'    End If

Application.ScreenUpdating = False
Set defosheet = ActiveSheet

'２つのデータが別シートに分かれている場合、データ範囲にシート名をつければ参照できる。
'しかしExcelの仕様で、シート名ありの場合65535行以上ではエラーが起きるため、シート名は付けられない。
'そのためにデータを１つのシートにまとめて処理する必要がある。
'新規に計算用シートを作成し、そこに各データを転記する
With ActiveWorkbook.Sheets.Add(before:=Sheets(1))
    
    .Name = "!!!!dummy!!!!"     '絶対被らない名前
    .Activate
    
    'キー範囲をコピー
    Key.Copy
    .Cells(1, 1).PasteSpecial Paste:=xlPasteValues
    Set Key = .Cells(1, 1).Resize(Key.Rows.Count, Key.Columns.Count)
    
    'キーの順番を設定して、広げる
    Key.Offset(, 1).Formula = "=row()"
    Set Key = Key.Resize(, 2)

    '検索範囲のコピー
    SR.Copy
    .Cells(1, Key.Columns.Count + 1).PasteSpecial Paste:=xlPasteValues
    Set SR = .Cells(1, Key.Columns.Count + 1).Resize(SR.Rows.Count, SR.Columns.Count)
End With

'データ範囲の文字列
SRad = "[" & SR.Address(False, False) & "]"
Keyad = "[" & Key.Address(False, False) & "]"

'DBを開く
Set CN = CreateObject("ADODB.Connection")
strfile = ActiveWorkbook.FullName
CNStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strfile _
& ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"
CN.Open CNStr
CN.CursorLocation = 3

'キーを検索範囲を紐付けて、セレクトする
'Orderby指定しないと、勝手に昇順SORTされてしまう。
'選択文字列
strSel_Sum = ""
For i = 0 To UBound(arGetIndex)
    If strSel_Sum = "" Then
        strSel_Sum = "select " & SRad & ".F" & arGetIndex(i)
    Else
        strSel_Sum = strSel_Sum & " , " & SRad & ".F" & arGetIndex(i)
    End If
Next

Sql = Join(Array(strSel_Sum, "from", Keyad, "left join", SRad, _
                "on", Keyad & ".F1", "=", SRad & ".F1", _
                "order by", Keyad & ".F2", "ASC"), " ")
                 
Set RS = CN.Execute(Sql)

'結果を貼り付ける。部分外部の場合は、結果のレコード数があっていないとダメ。
If Mode = 0 And RS.RecordCount <> Key.Rows.Count Then
    MsgBox "検索データに重複等があると思われます。中断します", vbInformation
Else
    Target(1).CopyFromRecordset RS
End If

'シート削除
Application.DisplayAlerts = False
    Sheets("!!!!dummy!!!!").Delete
Application.DisplayAlerts = True

'閉じる
On Error Resume Next
    RS.Close
    CN.Close
    Set RS = Nothing
    Set CN = Nothing
On Error GoTo 0

defosheet.Select
Target(1).Select
Application.ScreenUpdating = True

End Sub