Excel VBA SUMIFの高速化 | やさしいExcelVBA

Excel関数のSUMIFをVBAで高速化する方法をご説明します。

VLOOKUP関数やCOUNTIF関数同様に、SUMIF関数もデータ量が多いと処理時間が長くなります。

この「重たい関数」のSUMIFの処理を高速でVBAで再現したいと思います。

VLOOKUP関数と違いSumif関数はExcel2016でも、速度改善されていないようです。

そこで、「Dictionary」を使用する事で、非常に高速に出来ます。

また、高速ではありませんが通常の「WorksheetFunction.SumIf」のサンプルコードも記載します。

Countif、VLOOKUPやVBAの高速化は、次の記事をご覧ください。

1.SUMIF関数を高速化する方法
2.VBAでSUMIFを高速にするサンプルコード
3.Application.WorksheetFunction.SumIfで処理
4.サンプルデータダウンロード
6.まとめ

1.SUMIF関数を高速化する方法

VBAで高速にする方法はDictionary(連想配列)オブジェクトを使用する方法です。

DictionaryのKeyに検索値となる値を格納して、重複のないリストを生成します。

リストを作成する際にItemに合計したい列の値を合計してく方法を使用します。

Keyに同じ文字列が登録されていた場合はItemに合計したい値を加算していくことで、Sumifの様な挙動を再現できます。

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

2.VBAでSUMIFを高速にするサンプルコード

サンプルデータとコードでご説明します。

サンプルデータ

以下のような5万行×20万行(並びをランダム)のデータを用意しました。

「Application.WorksheetFunction.SumIf 」のループで、処理した場合は約35分かかりました。

ちなみに直接ExcelのSumIf関数で処理した場合10分くらいです。

これが、約2秒で処理されます。

A列に5万行の商品名、D列にランダムに並び替えた商品名20万行とE列に価格のデータです。

上記のデータのB列にA列を検索値として、Eの価格の合計を算出します。

サンプルコード

Option Explicit

    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 i           As Long
        Dim n           As Long
        Dim myStr       As String
        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

コードの説明

「SearchArray = Range(Cells(2, 1), Cells(MaxRowA, 2))」で検索値と算出結果を格納するために、A列の最終行を取得してA~B列を2次元配列に格納しています。

「RefArray = Range(Cells(2, 4), Cells(MaxRowD, 5))」で参照先データを格納するためD列の最終行を取得して、D~E列を配列に格納しています。

もし合計したい列が離れたところにある場合は、その範囲まで配列に格納して、配列の列数を指定するか、新たに合計用の配列を用意すると対応できると思います。

「Set myDic = CreateObject(“Scripting.Dictionary”)」でDictionaryを使用できるようにセットします。

「For n = 1 To UBound(RefArray)」で検索範囲のデータ(配列)をループします。

「Keyval = RefArray(n, 1)」と「Itemval = RefArray(n, 2)」でそれぞれKeyとなる値と、Itemに合算する値を格納します。

KeyにD列の商品名を、Itemに価格を格納しています。

「If Not myDic.Exists(Keyval) Then」でリストにすでに登録されているか判定して、未登録の場合は「myDic.Add Keyval, Itemval」で加算する値をそのまま格納します。

すでに登録済みの場合は「myDic(Keyval) = myDic(Keyval) + Itemval」で同じKeyにItemに合算します。

続いて、検索値用のKeyで合算したDictionaryから、値を抽出します。

「For n = 1 To UBound(SearchArray)」で検索値用に格納したA~B列の配列を要素数分ループします。

「Keyval = SearchArray(n, 1)」で検索値の条件となる値(A列に該当)を格納します。

「SearchArray(n, 2) = myDic(Keyval)」で検索値のKeyでItemを抽出します。

最後に、「Range(Cells(2, 1), Cells(MaxRowA, 2)) = SearchArray」で結果を一括で出力します。

最後にセルに一括で出力しています。

3.Application.WorksheetFunction.SumIfで処理

高速ではありませんが、ExcelのSumIf関数をVBAで使用する場合のコードです。

約35分かかりました。

Sub Sample2()

        Dim SearchArray As Variant
        Dim MaxRowA     As Long
        Dim MaxRowD     As Long
        Dim i           As Long
        Dim myStr       As String
        
        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  '最終行を再定義
        
        For i = 1 To UBound(SearchArray) 'A列要素数分ループ
        
            myStr = SearchArray(i, 1) '配列の値を格納
        
            SearchArray(i, 2) = _
            Application.WorksheetFunction.SumIf _
            (Range(Cells(2, 4), Cells(MaxRowD, 4)), myStr, Range(Cells(2, 5), Cells(MaxRowD, 5)))
        
        Next i
        
        Range(Cells(2, 1), Cells(MaxRowA, 2)) = SearchArray '結果出力
        
    End Sub