Excel VBA VLOOKUP関数で一致したデータをすべて取得する

ExcelVBA-実用編

VLOOKUP関数はそのまま使用すると上から順番に検索して、最初に一致した行の参照列の値を取得します。

非常に便利な関数ですが、問題は最初に一致した値しか取得できません。

もし検索値が重複してるデータであった場合、2つ目以降は検索されません。

今回は検索結果を最初だけではなくすべて取得する方法をご紹介します。

今回の方法は「WorksheetFunction.VLookup」は使用できません。

その他のVLOOKUP関数については、下記記事をご覧ください。

1.サンプルデータ

今回使用するデータは次のような形式です。

E列のユニーク(重複のない)になっている顧客リストに、A~B列の購入商品リストから購入商品を取得します。

本来VLOOKUP関数をそのまま使うと、1つの購入商品を取得したら次の顧客へ移動してしてしまいます。

2.For~Nextですべて取得する

単純に、すべての検索値をループして、同じ検索値の時にすべて取得する方法です。

この方法はデータ量が増えた場合に、ループ回数が増え処理速度が遅くなります。

Option Explicit

Sub Sample1()

Dim i       As Long
Dim n       As Long
Dim GetStr  As String
Dim myStr   As Variant

For i = 2 To 14 'E列のリスト分ループ

    GetStr = "" '格納用配列をリセット

    For n = 2 To 26 'データをループ
    
        If Cells(i, 5) = Cells(n, 1) Then
        
            GetStr = GetStr & Cells(n, 2) & "/" '検索結果を格納
        
        End If
    
    Next n
    
    myStr = Split(GetStr, "/") '「/」で区切る
    
    n = 0
    
    For n = 0 To UBound(myStr) '区切られた要素数分ループ
    
        Cells(i, n + 6) = myStr(n) '出力列に出力
    
    Next n
    
Next i

End Sub
コードの説明

サンプルコードの説明です。

ユニークの顧客リストのE列を検索値としてループします。

入れ子としてその中でデータをすべてループします。

顧客リストの検索値と一致した際に、配列に「/」で区切れるように「&」で繋げて格納します。

「myStr = Split(GetStr, “/”) 」で「/」で文字区切りをします。

区切られた要素数分ループして出力します。

3.Dictionaryで処理する方法(高速)

Dictionaryを使用して、「Key」に検索値、「Item」に「購入商品」としてリストを作成します。

同じ検索値は上記同様に連結します。

リスト作成後に、顧客リストの検索値から「Key」を取得します。

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

処理速度としては1番早いかと思います。

Sub Sample2()

    Dim Keyval      As String
    Dim ItemVal     As String
    Dim i           As Long
    Dim n           As Long
    Dim myStr       As Variant
    Dim myDic       As Object
    
    Set myDic = CreateObject("Scripting.Dictionary")
    
    For i = 2 To 26
                        
        Keyval = Cells(i, 1) 'Keyを格納
        ItemVal = Cells(i, 2) 'Itemを格納
        
        '登録されていなければ登録
        '※Dictionaryは重複登録出来ない
        If Not myDic.Exists(Keyval) Then
        
            myDic.Add Keyval, ItemVal
            
        Else
        
            myDic(Keyval) = myDic(Keyval) & "/" & ItemVal
            
        End If
        
    Next i
    
    For i = 2 To 14
    
        Keyval = Cells(i, 5)
        
        myStr = Split(myDic(Keyval), "/")
        
        For n = 0 To UBound(myStr) '区切られた要素数分ループ
    
            Cells(i, n + 6) = myStr(n) '出力列に出力
        
        Next n
    
    Next i
    
    Set myDic = Nothing

End Sub

タイトルとURLをコピーしました