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

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

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

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

この記事では大量データ処理時の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円”という値を格納するとき

  1. parentDic.add “り” , childDic
  2. childDic.add “りんご” , “100円”

このような形で2段階にします。

そして取り出すときも、まずは頭文字1文字で親辞書から子辞書を取得して、子辞書から値を取得するということになります。

コードの記述は面倒になってしまいますが、実際の案件で高速化することに成功しました。


頭文字が同じキーが多い場合、辞書がうまく分割されない問題

繰り返しになりますが、1つのDictionaryに10万件みたいな大量データを入れない事が重要になります。

しかし、頭文字が同じデータが大量にあった場合には、やはり1つの辞書が重くなりすぎてしまいます。

よって、コード値の1文字目に意味をもたせているケースなどは対応できません。(例えば社員コードで頭文字がhなら派遣社員とか)

その場合は、末尾で辞書を分けるとか、桁数が決まっているなら前3文字で辞書を分けるとかいう応用が必要になるかなと思います。

更にロジックは見にくくなってしまいそうですが…。


コメントを残す

メールアドレスが公開されることはありません。

日本語が含まれない投稿は無視されますのでご注意ください。(スパム対策)