2023年9月25日 / 最終更新日時 : 2024年1月7日 alljapan Excel

検索をDictionary使用にて高速化

このマクロは、「Dictionary（ディクショナリー）のパフォーマンスについて」を参考にしています。ありがとうございます。

シート「A」の番号を、シート「B」から一致する「id」を検索し、一致したら「Price」のデータを、シート「A」の「価格」をその「Price」に変更する例で説明します。

シート「A」は以下。7万行以上あります。

シート「B」は以下。3万行以上あります。

以下が、マクロです。

' 配列
Dim TableA() As Variant         ' シート「A」
Dim TableB() As Variant         ' シート「B」


Sub サンプルメイン()

    Dim sTimer As Single        ' 処理時間測定用
    sTimer = Timer
    
    Call sheet_to_array(ThisWorkbook.Worksheets("A"), TableA)        ' シート「A」を配列に入れる
    Call sheet_to_array(ThisWorkbook.Worksheets("B"), TableB)        ' シート「B」を配列に入れる
    
    Debug.Print "シート＞配列：" & Timer - sTimer  ' 処理時間測定用
    
    Call Dictionary使用sample
    
    Debug.Print "検索完了：" & Timer - sTimer & vbCrLf ' 処理時間測定用
    
End Sub



Private Sub Dictionary使用sample()

    Dim Keyval      As String
    Dim Itemval     As Long
    Dim n           As Long
    Dim myDic       As Object
        
    Set myDic = CreateObject("Scripting.Dictionary")
    
    For n = 2 To UBound(TableB)         '参照用の配列を要素数分ループ
                        
        Keyval = TableB(n, 2)           '③Keyを格納
        Itemval = TableB(n, 1)          '④Itemを格納
        
        '未登録の場合登録
        If Not myDic.Exists(Keyval) Then
            myDic.Add Keyval, Itemval
        End If
        
    Next n
    
    For n = 2 To UBound(TableA) '検索用配列の要素数分ループ
    
        Keyval = TableA(n, 2)
        
        If myDic.Exists(Keyval) Then
            TableA(n, 1) = myDic(Keyval)        '検索値のKeyでItemを抽出
        End If
    
    Next n
    
    Set myDic = Nothing
    
End Sub

順番に説明します。以下で、シートの値を配列に入れています。高速化の常套手段です。

    Call sheet_to_array(ThisWorkbook.Worksheets("A"), TableA)        ' シート「A」を配列に入れる
    Call sheet_to_array(ThisWorkbook.Worksheets("B"), TableB)        ' シート「B」を配列に入れる

「Call sheet_to_array」は、以下を参照してください。

「シート」を「配列」に入れる

以下で、Dictionary（連想配列）を作成しています。

    Set myDic = CreateObject("Scripting.Dictionary")
    
    For n = 2 To UBound(TableB)         '参照用の配列を要素数分ループ
                        
        Keyval = TableB(n, 2)           '③Keyを格納
        Itemval = TableB(n, 1)          '④Itemを格納
        
        '未登録の場合登録
        If Not myDic.Exists(Keyval) Then
            myDic.Add Keyval, Itemval
        End If
        
    Next n

以下で検索しています。

    For n = 2 To UBound(TableA) '検索用配列の要素数分ループ
    
        Keyval = TableA(n, 2)
        
        If myDic.Exists(Keyval) Then
            TableA(n, 1) = myDic(Keyval)        '検索値のKeyでItemを抽出
        End If
    
    Next n

この中の「TableA(n, 1) = myDic(Keyval) ‘検索値のKeyでItemを抽出」だけで、Dictionary（連想配列）から、一致する「id」を検索して、「Price」を返しています。

マクロを実行した結果、以下の通り、価格が「1」に変更されています。