VLOOKUP手法別の速度比較検証

Test_Lookup.bas.vba

Option Explicit

Property Get loDB(): Set loDB = Worksheets("DB").ListObjects(1): End Property
Property Get loVi(): Set loVi = Worksheets("View").ListObjects(1): End Property

Rem 総合テスト
Sub Test_LOOKUPs()
    Application.ScreenUpdating = False
    Dim tStart As Single, tStop As Single
    
    Debug.Print "Test_FormulaVLOOKUP",
    tStart = Timer
    Call Test_FormulaVLOOKUP
    tStop = Timer: Debug.Print Format$(tStop - tStart, "0.00") & " sec."
    
    Debug.Print "Test_WsfVLOOKUPforRange",
    tStart = Timer
    Call Test_WsfVLOOKUPforRange
    tStop = Timer: Debug.Print Format$(tStop - tStart, "0.00") & " sec."

    Debug.Print "Test_WsfVLOOKUPforValue",
    tStart = Timer
    Rem この処理は1分くらいかかるので実行には注意してください
    Call Test_WsfVLOOKUPforValue
    tStop = Timer: Debug.Print Format$(tStop - tStart, "0.00") & " sec."

    Debug.Print "Test_MyVbaVLOOKUP",
    tStart = Timer
    Call Test_MyVbaVLOOKUP
    tStop = Timer: Debug.Print Format$(tStop - tStart, "0.00") & " sec."

    Debug.Print "Test_DictionaryLookup",
    tStart = Timer
    Call Test_DictionaryLookup
    tStop = Timer: Debug.Print Format$(tStop - tStart, "0.00") & " sec."

    Debug.Print "Test_DictionaryLookup2",
    tStart = Timer
    Call Test_DictionaryLookup
    tStop = Timer: Debug.Print Format$(tStop - tStart, "0.00") & " sec."
End Sub

Sub Test_FormulaVLOOKUP()
    Dim dbRng: Set dbRng = loDB.DataBodyRange
    
    Dim rng As Range
    Set rng = loVi.ListColumns("ふりがな").DataBodyRange
    rng.Formula = "=VLOOKUP([@名前],DB!A2:L5001,2,FALSE)"
    rng.Value = rng.Value
End Sub

Sub Test_MyVbaVLOOKUP()
    Dim dbRng: Set dbRng = loDB.DataBodyRange
    Dim dbVal: Let dbVal = loDB.DataBodyRange.Value
    Dim rr As Long
    
    Dim data: data = loVi.ListColumns("名前").DataBodyRange.Value
    For rr = 2 To UBound(data)
        data(rr, 1) = MyVLOOKUP(data(rr, 1), dbVal, 2)
    Next
    loVi.ListColumns("ふりがな").DataBodyRange.Value = data
End Sub

Sub Test_WsfVLOOKUPforRange()
    Dim dbRng: Set dbRng = loDB.DataBodyRange
    Dim rr As Long
    
    Dim data: data = loVi.ListColumns("名前").DataBodyRange.Value
    For rr = 2 To UBound(data)
        data(rr, 1) = WorksheetFunction.VLookup(data(rr, 1), dbRng, 2, False)
    Next
    loVi.ListColumns("ふりがな").DataBodyRange.Value = data
End Sub

Rem この処理は1分くらいかかるので実行には注意してください
Sub Test_WsfVLOOKUPforValue()
    Dim dbRng: Set dbRng = loDB.DataBodyRange
    Dim dbVal: Let dbVal = loDB.DataBodyRange.Value
    Dim rr As Long
    
    Dim data: data = loVi.ListColumns("名前").DataBodyRange.Value
    For rr = 2 To UBound(data)
        data(rr, 1) = WorksheetFunction.VLookup(data(rr, 1), dbVal, 2, False)
    Next
    loVi.ListColumns("ふりがな").DataBodyRange.Value = data
End Sub

Function MyVLOOKUP(Key, data, indexColumn)
    Dim rr As Long
    For rr = 1 To UBound(data)
        If data(rr, 1) = Key Then
            MyVLOOKUP = data(rr, indexColumn)
            Exit Function
        End If
    Next
    MyVLOOKUP = CVErr(2042)
End Function

Rem Dictionary（辞書）を使用した検証
Sub Test_DictionaryLookup()
    Dim dbRng: Set dbRng = loDB.DataBodyRange
    Dim dbVal: Let dbVal = loDB.DataBodyRange.Value
    Dim rr As Long
    
    Dim data: data = loVi.ListColumns("名前").DataBodyRange.Value
    For rr = 2 To UBound(data)
        data(rr, 1) = MyDictionary(data(rr, 1), dbVal, 2)
    Next
    loVi.ListColumns("ふりがな").DataBodyRange.Value = data
End Sub

Rem 2回目以降の検索はキャッシュで高速化する
Rem indexColumnは列番号でも列名でもOK（おまけ）
Rem dataが変化したきキャッシュを再構築しないといけないが今回は無視
Rem 暫定でキャッシュをを消したければENDステートメントを使う
Function MyDictionary(Key, data, indexColumn)
    Static dic As Dictionary
    If dic Is Nothing Then
        Set dic = New Dictionary
        Dim rec As Dictionary
        Dim rr As Long, cc As Long
        For rr = UBound(data) To 1 Step -1
            Set rec = New Dictionary
            For cc = 1 To UBound(data, 2)
                rec(data(1, cc)) = data(rr, cc)
            Next
            Set dic(data(rr, 1)) = rec
        Next
    End If
    
    If dic.Exists(Key) Then
        If VarType(indexColumn) = vbString Then
            MyDictionary = dic(Key)(indexColumn)
        Else
            MyDictionary = dic(Key).Items()(indexColumn - 1)
        End If
    Else
        MyDictionary = CVErr(2042)
    End If
End Function

以下のツイートがきっかけで、WorksheetFunction.Vlookupが本当に遅いのか簡易的な確認を行いました。
https://twitter.com/sugoi_kaizen/status/1474266832798650370?s=20

前提条件

• 書き込みは配列を使用する。
• データは、「なんちゃって個人情報」で生成した5000件
• どちらのシートもテーブル化済み（個人的な好みによる）

結果

1. wsf.Vlookupより数式VLOOKUPのほうが倍くらい早い
2. wsf.Vlookupは第2引数(範囲)にValue(VBA内二次元配列)を指定したとき50倍くらい遅くなる
3. やはりDictionaryは早かった

概要

基礎データ DB

作業データ View

計測結果