Excel VBA Dictionaryを確実に高速処理する方法と比較

高速化

今回は筆者が好んで使うDictionaryを確実に高速処理する方法のご説明です。

というのも、処理をものすごく遅くしてしまう記述方法があり、遅くなる書き方をしていないか注意という感じになります。

仮に遅い書き方をしても配列の「データ×データ」のループより早いのですが、ある記述方法をするとびっくりするくらい遅くなる方法があります

検証結果をお伝えしますと、同じ処理結果でも350倍も処理速度が違います。

この遅い方法を使用している方は少数かと思いますが、Dictionaryは早いと認識しつつも、無自覚に今回紹介する記述方法を使用している可能性があるという事です。

そこで、比較しつつ記述方法をご説明します。

Dictionaryの基本的な使い方や、Dictionaryを使用して高速化したVLOOKUP、COUNTIF、SUMIFの記事は下記の記事をご覧ください。

また、一般的な高速化方法の記事も記載しておきます。

1.Dictionaryの使い方

基礎的な部分ですが、Dictionaryの使い方を簡単に説明します。

DictionaryはKey(キー)とItem(データ)をセットで格納する「連想配列」です

Key(キー)とItem(データ)をセットで格納して、リストなどを作成するときに使用します。

最大の特徴はKeyを指定する事でItemを抽出出来る事です。

リスト作成して、Keyを基にItemを抽出できる特徴を利用して高速のVLOOKUP関数等を作成しています。

2.Dictionaryが高速な理由

なぜDictionaryが高速かと言いますと、ループを最小限にすることが出来るからです。

例えば、A列に10万行のデータとB列に10万行のデータがあったとします。

「A列のデータが、B列に何個あるかすべて数える」を配列で処理しようとしたら、データ数×データ数のループが発生します。

10万×10万・・・。

膨大な処理が行われますので、データ量が増えれば増えるほど遅くなるのは明確ですね。

これをDictionaryにするとB列の10万行にリストとして格納して、同じKeyの場合は加算しておきます。

あとはA列の10万行をKeyとしてDictionaryからItemを抽出すればいいのです。

つまり、格納に10万ループ、抽出に10万ループで20万ループのみです

これが処理速度が速い理由です。

3.通常(高速)のDictionaryを実証

まずはDictionaryがどれほど早いか実証してみます。

次のようなA列に5万行とD~E列に20万行のデータがあります。

B列にはA列が4つずつありますので、DictionaryでSUMIFを行うと合算されます。

この処理を通常の方法で記述すると次のようになります。

Sub Sample1()

        Dim SearchArray As Variant
        Dim RefArray    As Variant
        Dim Keyval      As String
        Dim Itemval     As Long
        Dim MaxRowA     As Long
        Dim MaxRowD     As Long
        Dim n           As Long
        Dim myDic       As Object
            
        MaxRowA = Cells(Rows.Count, 1).End(xlUp).Row '最終行を取得
        SearchArray = Range(Cells(2, 1), Cells(MaxRowA, 2)) '①A列と出力用にB列も配列格納
        
        MaxRowD = Cells(Rows.Count, 4).End(xlUp).Row '最終行を取得
        RefArray = Range(Cells(2, 4), Cells(MaxRowD, 5)) '②参照データとしてD~E列を格納
        
        Set myDic = CreateObject("Scripting.Dictionary")
        
        For n = 1 To UBound(RefArray) '参照用の配列を要素数分ループ
                            
            Keyval = RefArray(n, 1) '③Keyを格納
            Itemval = RefArray(n, 2) '④Itemを格納
            
            '未登録の場合登録
            '登録済みの場合はItemにE列の値を加算
            If Not myDic.Exists(Keyval) Then
            
                myDic.Add Keyval, Itemval
                
            Else
            
                myDic(Keyval) = myDic(Keyval) + Itemval
                
            End If
            
        Next n
        
        For n = 1 To UBound(SearchArray) '検索用配列の要素数分ループ
        
            Keyval = SearchArray(n, 1)
            
            SearchArray(n, 2) = myDic(Keyval) '検索値のKeyでItemを抽出
        
        Next n
        
        Range(Cells(2, 1), Cells(MaxRowA, 2)) = SearchArray '結果出力
        
        Set myDic = Nothing
    
    End Sub

5万行×20万行の「SUMIF」が2.6秒です

普通に考えてExcel関数と比較すると考えられない (400~500倍) くらい高速です。

通常Excelの関数で計算すると、PCスペックにもよりますが普通に10分以上かかります

せっかく高速なのに、このDictionaryが記述方法によっては処理速度が非常に遅くなります。

4.Dictionaryを遅くする記述方法

記述次第で超高速なDictionaryがとても遅くなります。

その記述方法というのが、DictionaryのKeyやItemの格納された要素の参照方法です。

通常はKeyやItemをループして、格納されている要素を参照する場合は次の様に記述します。

※検証用に回りくどいコードとなっています。

Sub Sample2()
    
    Dim MyDic       As Object
    Dim DicKey      As Variant
    Dim DicItem     As Variant
    Dim MaxRow      As Long
    Dim i           As Long
    Dim MyStr       As String
    Dim Keyval      As String
    Dim Itemval     As Long
    
    Set MyDic = CreateObject("Scripting.Dictionary")
    
    MaxRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To MaxRow
    
        Keyval = Cells(i, 1)
        Itemval = Cells(i, 2)
        
        If Not MyDic.Exists(Keyval) Then
            
            MyDic.Add Keyval, Itemval
            
        End If
    
    Next i
    
    DicKey = MyDic.Keys
    DicItem = MyDic.Items
    
    For i = 0 To UBound(DicKey)
    
        MyStr = MyStr & DicKey(i) & "/" & DicItem(i) & vbCrLf
        
    Next i
    
    MsgBox MyStr
    
    End Sub

上記の様に、KeyやItemを配列の変数に格納してから、要素数分ループします。

これをKeyもItemも変数に格納せず次のように記述する事が出来ます。

これが問題のコードです。

Sub Sample3()
    
    Dim MyDic       As Object
    Dim MaxRow      As Long
    Dim i           As Long
    Dim MyStr       As String
    Dim Keyval      As String
    Dim Itemval     As Long
    
    Set MyDic = CreateObject("Scripting.Dictionary")
    
    MaxRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To MaxRow
    
        Keyval = Cells(i, 1)
        Itemval = Cells(i, 2)
        
        If Not MyDic.Exists(Keyval) Then
            
            MyDic.Add Keyval, Itemval
            
        End If
    
    Next i
    
    For i = 0 To MyDic.Count - 1
    
        MyStr = MyStr & MyDic.keys()(i) & "/" & MyDic.items()(i) & vbCrLf
        
    Next i
    
    MsgBox MyStr
    
    End Sub

変数に格納せず、直接Dictionaryを参照する方法です。

ループ回数自体は一緒ですが、処理速度が全然違います。

5.処理速度の検証

本題の処理速度の比較をしたいと思います。

今回比較するために使用する処理する方法はこんなイメージです。

2つのDictionaryを用意して、1つをもう1つのDictionaryにフィルターの役割を持たせて、分岐させる方法です。

図にするとこんな感じです。

Dictionary はリスト作成以外にも、こんな使い方をする事で処理を高速にできたりします。

A~B列の100個のフィルター用のDictionaryと、E~F列の10万データ格納したDictionaryを用意してループして、フィルター用のDictionaryに登録されていたら合算していくコードで検証します。

早いコード

Sub Sample4()
        
    Dim CheckDic    As Object
    Dim ListDic     As Object
    Dim MaxRow      As Long
    Dim i           As Long
    Dim MyStr       As String
    Dim Keyval      As String
    Dim Itemval     As Long
    Dim DicKey      As Variant
    Dim DicItem     As Variant
    Dim SumInt      As Long  
   
    '=================フィルター用Dic作成=================
    
    Set CheckDic = CreateObject("Scripting.Dictionary")
    
    MaxRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To MaxRow 'A~B列をDicに格納
    
        Keyval = Cells(i, 1)
        Itemval = Cells(i, 2)
        
        If Not CheckDic.Exists(Keyval) Then
            
            CheckDic.Add Keyval, Itemval
            
        End If
    
    Next i
    
    '================分類にかける用Dic作成================
    
    Set ListDic = CreateObject("Scripting.Dictionary")
    
    MaxRow = Cells(Rows.Count, 5).End(xlUp).Row
    
    For i = 2 To MaxRow 'E~F列をDicに格納
    
        Keyval = Cells(i, 5)
        Itemval = Cells(i, 6)
        
        If Not ListDic.Exists(Keyval) Then
            
            ListDic.Add Keyval, Itemval '未登録なら新規追加
            
        Else
        
            ListDic(Keyval) = ListDic(Keyval) + Itemval '登録済みなら加算
            
        End If
    
    Next i
    
    DicKey = ListDic.keys 'Keyを配列に格納
    DicItem = ListDic.items 'Itemを配列に格納
    
    '==================フィルターにかける==================
    SumInt = 0
    
    For i = 0 To UBound(DicKey)
    
        Keyval = DicKey(i)
        Itemval = DicItem(i)
    
        If CheckDic.Exists(Keyval) Then 'フィルター用に登録されていたら加算
            
            SumInt = SumInt + Itemval
            
        End If
        
    Next i
    
    MsgBox SumInt
    
    End Sub

10万行のデータを100個のフィルターにかけて、該当するKeyのItemを合算するのに「1.84秒」でした。(計測コードは削除しています。)

遅いコード

次は遅いコードで検証です。

Sub Sample5()
    
    Dim CheckDic    As Object
    Dim ListDic     As Object
    Dim MaxRow      As Long
    Dim i           As Long
    Dim MyStr       As String
    Dim Keyval      As String
    Dim Itemval     As Long
    Dim DicKey      As Variant
    Dim DicItem     As Variant
    Dim SumInt      As Long

    '=================フィルター用Dic作成=================
    
    Set CheckDic = CreateObject("Scripting.Dictionary")
    
    MaxRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To MaxRow 'A~B列をDicに格納
    
        Keyval = Cells(i, 1)
        Itemval = Cells(i, 2)
        
        If Not CheckDic.Exists(Keyval) Then
            
            CheckDic.Add Keyval, Itemval
            
        End If
    
    Next i
    
    '================分類にかける用Dic作成================
    
    Set ListDic = CreateObject("Scripting.Dictionary")
    
    MaxRow = Cells(Rows.Count, 5).End(xlUp).Row
    
    For i = 2 To MaxRow 'E~F列をDicに格納
    
        Keyval = Cells(i, 5)
        Itemval = Cells(i, 6)
        
        If Not ListDic.Exists(Keyval) Then
            
            ListDic.Add Keyval, Itemval '未登録なら新規追加
            
        Else
        
            ListDic(Keyval) = ListDic(Keyval) + Itemval '登録済みなら加算
            
        End If
    
    Next i
    
    '==================フィルターにかける==================
    SumInt = 0
    
    For i = 0 To ListDic.Count - 1
    
        If CheckDic.Exists(ListDic.keys()(i)) Then 'フィルター用に登録されていたら加算
            
            SumInt = SumInt + ListDic.items()(i)
            
        End If
        
    Next i
        
    MsgBox SumInt
        
    End Sub

計測結果は「620秒」でした・・・。

10分以上かかってしまい、約350倍遅いですね(内心は5分程度を予想してました。)

6.結論

長くなりましたが、結論です。

配列に格納:1.84秒

直接参照:620秒

高速のDictionaryも参照方法を間違えると非常に遅くなります。

理由としてはVBAはセルやシートなどのオブジェクトの参照が非常に遅いです

Dictionaryも「オブジェクト」ですので、直接参照するとやはり例外なく遅くなるのではないと思います。

そのため、もしDictionaryをループするの場合は一度配列に格納してからループする事をお勧めします。

すでに直接参照しているコードがありましたら、書き換える事で大幅に処理速度を改善できると思いますので、試してみてはいかがでしょうか。

この様なコードを書く人は少ないでしょうけど。

どちらかというと、Dictionaryを使ってフィルターをするロジックの方が意味のある情報かもしれません。

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