【VBA】Dictionaryの件数が多くなると処理が遅くなる

大量データ処理時のVBAの性能対策で2番目に悩まされるのが、Dictionaryの追加と取得の処理が遅くなってくることだと思います。

ちなみに、最も悩ましいのがセルへのアクセスだと思います。

セルのアクセスは時間がかかるため、大量のセルを処理すると処理時間が膨大になってしまいます。これにつきましては以下の記事で対策を記載しています。

処理が遅いVBAコードを改善するには「セル単位で処理をする」のをやめよう

この記事では大量データ処理時のDictionaryの処理速度改善について記載をしたいと思います。

Dictionaryの取得処理が遅くなる

私が昔対応したVBAプログラムで、処理に1時間以上かかってしまい、顧客から改善の要望があったことがあります。

どの処理に時間がかかっているかを調査したところ、Dictionaryからデータを取り出すところで時間がかかっていることがわかりました。

※Dictionary.Item(Key)の処理になります。

Dictionaryの件数が多くなるに従って遅くなり始め、10万件を超えると1秒以上になっていたと記憶しています。

以下のサイトでは実際にDictionaryのパフォーマンスを測定されていますが、それによると2次関数的にDictionaryは遅くなるようです。

処理件数に対して、処理時間が、2次曲線を描いています。
10倍（10万件）で計算すると21分以上の時間になってしまいます。
さすがに、これでは・・・
https://excel-ubara.com/excelvba4/EXCEL268.html

※上記サイトでは、3万件程度では「Dictionaryからセルに出力するのが遅い」と結論づけているようです。更に増えてくるとDictionaryから取得する処理が遅くなってくるはずです。

対策：Dictionaryを分割する

Dictionaryの件数が多くなってしまうと、処理時間が2次曲線を描いてしまうということで「じゃあDictionaryに格納する件数を減らそう」と思い、以下のようなロジックを組んで処理対策をいたしました。

Keyの頭文字をKeyにして子供のDictionaryを作る

うーん…言葉にするのが難しい。

さっぱりわからないと思うのでサンプルプログラムを示します。（クラスモジュールの例です）

Private dicParent As Object

Private Sub Class_Initialize()
    Set dicParent = CreateObject("Scripting.Dictionary")
End Sub

'辞書にアイテムを追加する関数
Public Sub add(key As String, value As Variant)
    If key = "" Then Exit Sub
    
    'キーの1文字目を取得
    Dim headFig As String
    headFig = Left(key, 1)
    
    '子辞書を作成し、キーの1文字目をキーに設定する
    Dim dicChild As Object
    If Not dicParent.exists(headFig) Then
        Set dicChild = CreateObject("Scripting.Dictionary")
        dicParent.add Left(key, 1), dicChild
    Else
        Set dicChild = dicParent.item(headFig)
    End If
    
    If dicChild.exists(key) Then
        MsgBox "キーが重複しています"
        Exit Sub
    End If
    
    '親辞書に子辞書を追加する
    dicChild.add key, value
    dicParent.item(headFig) = dicChild
End Sub

'辞書からアイテムを取得する関数
Public Function item(key As String) As Variant
    If key = "" Then Exit Function
    Dim headFig As String
    headFig = Left(key, 1)
    If Not dicParent.exists(headFig) Then
        MsgBox "キーがありません"
        Exit Function
    End If
    
    Dim dicChild As Object
    Set dicChild = CreateObject("Scripting.Dictionary")
    If Not dicChild.exists(key) Then
        MsgBox "キーがありません"
        Exit Function
    End If
    
    item = dicChild.item(key)
End Function

具体例も書くと、”りんご”というキーと”100円”という値を格納するとき