Excel VBA VLOOKUPの複数条件を高速で処理する方法

今回はVLOOKUP関数の検索条件を複数指定する方法をご説明します。

①作業列が不要な方法と、②作業列を追加してVLOOKUPの数式を使用した方法、さらに③WorksheetFunction.VLookupを使用した方法の3つご説明します。

①と②については高速で処理します。

Excelのみで処理する場合は、作業列を追加して「＆」で結合してから、通常のVLOOKUP関数を使用するかと思います。

VBAで処理する場合も考え方自体は同様です。
結合した文字列をKeyとして「Dictionary」を使用する事で、高速に処理する事が出来ます。

Excel2016の場合はVLOOKUP関数が速くなっているので、処理速度は速いと思いますが、Excel2016前のバージョンや、処理が遅いと思う方はこちらの方法を使用してみてください。

VLOOKUPやCOUNTIFの高速化は次の記事をご覧ください。

1.複数条件のVLOOKUPを高速で処理する方法
2.VLOOKUP関数の数式埋め込みで複数条件の処理
3.WorksheetFunction.VLookupで複数条件の処理
4.サンプルファイルのダウンロード
5.まとめ

1.複数条件のVLOOKUPを高速で処理する方法

まず、検索用のデータと、参照先のデータを配列に格納します。

次に参照先の配列から、複数条件の文字列を「＆」で結合しDictionaryのKeyに追加します。

「Dictionary」の使い方は「Excel VBA Dictionaryの使い方」をご覧ください。

リストを作成したら、検索用の配列をループで検索文字列をKeyとして、DictionaryのItemを抽出します。

サンプルデータとサンプルコードです。

検索用にA列に店舗名、B列に商品名と、参照先用にE列に店舗名、F列に商品名、G列に各商品の価格が、それぞれ10万行あるデータを用意しました。

Option Explicit

    Sub Sample1()

        Dim SearchArray As Variant
        Dim RefArray    As Variant
        Dim Keyval      As String
        Dim ItemVal     As Long
        Dim MaxRow      As Long
        Dim i           As Long
        Dim n           As Long
        Dim myDic       As Object
            
        MaxRow = Cells(Rows.Count, 1).End(xlUp).Row '最終行を取得
        SearchArray= Range(Cells(2, 1), Cells(MaxRow, 3)) '①AとB列と出力用にC列も配列格納
        RefArray = Range(Cells(2, 5), Cells(MaxRow, 7)) '②参照データとしてE～G列を格納
        
        Set myDic = CreateObject("Scripting.Dictionary")
        
        For n = 1 To UBound(RefArray) '参照用の配列を要素数分ループ
                            
            Keyval = RefArray(n, 1) & RefArray(n, 2)  '③条件を結合してKeyを格納
            ItemVal = RefArray(n, 3) '④Itemを格納
            
            '登録されていなければ登録
            '※Dictionaryは重複登録出来ない
            '今回のサンプルデータは初めから重複はありません。
            If Not myDic.Exists(Keyval) Then
            
                myDic.Add Keyval, ItemVal
                
            End If
            
        Next n
        
        For n = 1 To UBound(SearchArray) '検索用配列の要素数分ループ
        
            Keyval = SearchArray(n, 1) & SearchArray(n, 2) '検索値の条件を結合
            
            SearchArray(n, 3) = myDic(Keyval) '検索値のKeyでItemを抽出
        
        Next n
        
        Range(Cells(2, 1), Cells(MaxRow, 3)) = SearchArray'結果出力
        
        Set myDic = Nothing
    
    End Sub

測定結果としては約4秒でした。

さすがに単体の条件の2秒とまではいきませんが、通常のVLOOKUP関数よりは速いと思います。

2.VLOOKUP関数の数式埋め込みで複数条件の処理

直接セルにVLOOKUP関数の数式を埋め込む方法です。

こちらはExcel2016以降であれば、高速で処理されます。

約5秒くらいでした。

それ以前のバージョンだと約10分くらいかかります。

数式を直接入力する形のため、作業列としてD列に一度検索文字列を結合して出力しています。

また、注意点として「“=VLOOKUP(“”” & myStr & “””,」部分の「”」ですが、こちらは「”」を文字列として扱うために、「“””」をしています。

Sub Sample2()

        Dim SearchArray As Variant
        Dim RefArray()  As Variant
        Dim MaxRow      As Long
        Dim i           As Long
        Dim myStr       As String
        
        MaxRow = Cells(Rows.Count, 1).End(xlUp).Row '最終行を取得
        SearchArray= Range(Cells(2, 1), Cells(MaxRow, 3)) 'A列と出力用にB列も配列格納
        
        ReDim RefArray(0 To MaxRow - 1, 0 To 0) '結合するためセル範囲を一括で格納できません。
        
        For i = 0 To MaxRow - 1
        
            RefArray(i, 0) = Cells(i + 1, 5) & Cells(i + 1, 6)
        
        Next i
        
        Range(Cells(1, 4), Cells(MaxRow, 4)) = RefArray '作業列に格納
        
        For i = 1 To UBound(SearchArray) 'A列要素数分ループ
        
            myStr = SearchArray(i, 1) & SearchArray(i, 2) '配列の値を格納
        
            SearchArray(i, 3) = "=VLOOKUP(""" & myStr & """,$D$2:$G$100001,4,0)" '「”」を文字列として扱う
        Next i
        
        Range(Cells(2, 1), Cells(MaxRow, 3)) = SearchArray'結果出力
        
    End Sub

3.WorksheetFunction.VLookupで複数条件の処理

「Application.WorksheetFunction.VLookup」を使用した方法で、複数条件のVLOOKUPのコードも記載します。

処理速度は約20分でした。

こちらも作業列が必要となるため、D列に検索用の文字列を結合したデータを出力しています。

Sub Sample3()

        Dim SearchArray As Variant
        Dim RefArray()  As Variant
        Dim MaxRow      As Long
        Dim i           As Long
        Dim myStr       As String
        
        MaxRow = Cells(Rows.Count, 1).End(xlUp).Row '最終行を取得
        SearchArray= Range(Cells(2, 1), Cells(MaxRow, 3)) 'A列と出力用にB列も配列格納
        
        ReDim RefArray(0 To MaxRow - 1, 0 To 0) '結合するためセル範囲を一括で格納できません。
        
        For i = 0 To MaxRow - 1
        
            RefArray(i, 0) = Cells(i + 1, 5) & Cells(i + 1, 6)
        
        Next i
        
        Range(Cells(1, 4), Cells(MaxRow, 4)) = RefArray '作業列に格納
        
        For i = 1 To UBound(SearchArray) 'A列要素数分ループ
        
            myStr = SearchArray(i, 1) & SearchArray(i, 2) '配列の値を格納
        
            SearchArray(i, 3) = _
Application.WorksheetFunction.VLookup(myStr, Range(Cells(2, 4), Cells(MaxRow, 7)), 4, 0)
        Next i
        
        Range(Cells(2, 1), Cells(MaxRow, 2)) = SearchArray'結果出力
        
    End Sub