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

今回はExcel関数の「SUMIFS」をVBAで高速化する方法をご説明します。

ExcelのSUMIFS関数は、複数の条件を指定して合計を算出する関数です。

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

そこで、VBAで高速化する方法をご説明します。

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

1.SUMIFS関数を高速化する方法
2.VBAでSUMIFSを高速にする方法
3.SUMIFS関数を直接数式で埋め込む方法
4.Application.WorksheetFunction.SumIfsで処理
5.サンプルデータダウンロード
6.まとめ

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

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

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

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

2.VBAでSUMIFSを高速にする方法

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

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

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

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

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

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

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

Sub Sample1()

    Dim SearchArray As Variant
    Dim RefArray    As Variant
    Dim Keyval      As String
    Dim Itemval     As Long
    Dim MaxRowA     As Long
    Dim MaxRowE     As Long
    Dim i           As Long
    Dim n           As Long
    Dim myDic       As Object

    MaxRowA = Cells(Rows.Count, 1).End(xlUp).Row '最終行を取得
    MaxRowE = Cells(Rows.Count, 5).End(xlUp).Row '最終行を取得
    SearchArray = Range(Cells(2, 1), Cells(MaxRowA, 3)) '①AとB列と出力用にC列も配列格納
    RefArray = Range(Cells(2, 5), Cells(MaxRowE, 7)) '②参照データとしてE～G列を格納
    
    Set myDic = CreateObject("Scripting.Dictionary")
    
    For n = 1 To UBound(RefArray) '参照用の配列を要素数分ループ
    
        Keyval = RefArray(n, 1) & RefArray(n, 2)  '③条件を結合してKeyを格納
        Itemval = RefArray(n, 3) '合計したい値をItemに格納
        
        '登録されていなければ登録
        '※Dictionaryは重複登録出来ない
        '今回のサンプルデータは初めから重複はありません。
        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) '検索値の条件を結合
        
        SearchArray(n, 3) = myDic(Keyval) '検索値のKeyでItemを抽出
    
    Next n
    
    Range(Cells(2, 1), Cells(MaxRowA, 3)) = SearchArray  '結果出力
    
    Set myDic = Nothing

End Sub

コードの簡単な説明です。

検索値と算出結果を格納するため、A列の最終行を取得してA~C列を2次元配列に格納しています。

参照先データを格納するためE列の最終行を取得して、E~G列を配列に格納しています。

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

Dictionaryに参照先のデータ(配列)をループで格納します。

KeyにE列の店舗名とF列の商品名を「&」で連結した文字列を、Itemに価格を格納しています。

ポイントは格納時にすでに登録済みの場合はItemに合算します。

全て合算したら、検索値の配列をループして、検索値(Key)としてDictionaryから値(Item)を抽出しています。

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

3.SUMIFS関数を直接数式で埋め込む方法

文字列として数式を、セルに直接埋め込む方法です。

少しでも処理速度を上げるために再計算と描画を停止しています。

こちらも同じく処理時間が約50分かかりました。

Sub Sample2()
    
    Dim MaxRow      As Long
    Dim i           As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    MaxRow = Cells(Rows.Count, 1).End(xlUp).Row '最終行を取得
    
    For i = 2 To MaxRow
    
        '関数の構文「Sumifs(合計範囲,条件範囲1,条件1,条件範囲2,条件2)」
        Cells(i, 3) = "=SUMIFS($G$2:$G$200001,$E$2:$E$200001,A" & i & ",$F$2:$F$200001,B" & i & ")" '「”」を文字列として扱う
    
    Next i
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
End Sub

4.Application.WorksheetFunction.SumIfsで処理

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

約40分かかりました。(あまりに時間がかかったためハイスペックPCで検証中)

Sub Sample3()

    Dim SearchArray As Variant
    Dim MaxRowA     As Long
    Dim MaxRowE     As Long
    Dim i           As Long
    
    MaxRowA = Cells(Rows.Count, 1).End(xlUp).Row '最終行を取得
    MaxRowE = Cells(Rows.Count, 5).End(xlUp).Row '最終行を取得
    
    SearchArray = Range(Cells(2, 1), Cells(MaxRowA, 3)) 'A列と出力用にB列も配列格納
    
    For i = 1 To UBound(SearchArray) 'A列要素数分ループ
    
    SearchArray(i, 3) = _
    Application.WorksheetFunction.SumIfs(Range(Cells(2, 7), Cells(MaxRowE, 7)), Range(Cells(2, 5), Cells(MaxRowE, 5)), SearchArray(i, 1) _
                                    , Range(Cells(2, 6), Cells(MaxRowE, 6)), SearchArray(i, 2))
    
    Next i
    
    Range(Cells(2, 1), Cells(MaxRowA, 3)) = SearchArray '結果出力
    
End Sub