Excel VBA COUNTIFSを高速化

ExcelVBA-実用編

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

COUNTIFS関数はデータ量が増えると非常に処理、再計算の処理時間が長くなってしまいます。

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

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

サンプルコードを使って説明していきたいと思います。

高速の方法だけではなく、通常の「Application.WorksheetFunction.Countifis」の方法や、数式を埋め込む方法についても併せてご紹介します。

VLOOKUP、COUNTIF、SUMIFの高速化は次の記事をご覧ください。

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

1.COUNTIFSを高速で処理する方法

高速で処理する方法

COUNTIFSは指定した範囲の中から複数の検索値と一致するデータの個数をカウントする数式です。

このCOUNTIFSの条件となる「複数の検索値」を文字列を「&」で結合します。

結合してしまえば、あとはDictionaryでCOUNTIFと処理するロジックは、ほとんど一緒です。

サンプルデータとサンプルコードを使用して説明したいと思います。

サンプルコード

検索用にA列に店舗名、B列に商品名の5万行のデータと、参照先としてE列に店舗名、F列に商品名の15万行のデータを用意しました。

Sub Sample1()

        Dim SearchArray As Variant
        Dim RefArray    As Variant
        Dim Keyval      As String
        Dim MaxRowA     As Long
        Dim MaxRowE     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(MaxRowD, 6)) '②参照データとしてE~G列を格納
        
        Set myDic = CreateObject("Scripting.Dictionary")
        
        For n = 1 To UBound(RefArray) '参照用の配列を要素数分ループ
                            
            Keyval = RefArray(n, 1) & RefArray(n, 2)  '③条件を結合してKeyを格納
            
            '登録されていなければ登録
            '※Dictionaryは重複登録出来ない
            '今回のサンプルデータは初めから重複はありません。
            If Not myDic.Exists(Keyval) Then
            
                myDic.Add Keyval, 1
                
            Else
            
                myDic(Keyval) = myDic(Keyval) + 1
                
            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

5万×15万行でも2.6秒でした。

単一のCountifの2秒よりは時間かかりましたが、それでも早いと思います。

コードの説明

「SearchArray = Range(Cells(2, 1), Cells(MaxRowA, 3))」でA列とB列の検索値と、結果を出力するためのC列を配列に格納します。

「RefArray = Range(Cells(2, 5), Cells(MaxRowD, 6))」で検索範囲として配列に格納します。

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

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

ここからループ内で検索値のカウント処理を行います。

「Keyval = RefArray(n, 1) & RefArray(n, 2) 」で検索対象となるリスト生成するために、結合して変数に格納します。

「If Not myDic.Exists(Keyval) Then」で先ほど検索値となる変数がDictionaryのKeyに登録されているかを判定しています。

「Not」を付ける事で「登録されていなければ」という判定になります。

「myDic.Add Keyval, 1」で未登録の場合はカウント1を、「Else」で登録されている場合は、同じKeyに+1加算してItemに格納します。

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

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

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

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

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

2.Application.WorksheetFunction.Countifisで処理する方法

こちらは検索と参照をそれぞれ指定して、Countifs関数で処理する方法です。

Countifs関数は「検索範囲1,検索値1,検索範囲2,検索値2」と記述します。

こちらは約30分かかりました。

Sub Sample2()

        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 '最終行を取得
        
        ReDim SearchArray(0 To MaxRowA - 1, 0 To 0) '結合するためセル範囲を一括で格納できません。
                
        For i = 0 To UBound(SearchArray) 'A列要素数分ループ
        
            SearchArray(i, 0) = _
            Application.WorksheetFunction.CountIfs _
            (Range(Cells(2, 5), Cells(MaxRowE, 5)), Cells(i + 2, 1), Range(Cells(2, 6), Cells(MaxRowE, 6)), Cells(i + 2, 2))
            
        Next i
        
        Range(Cells(2, 3), Cells(MaxRowA, 3)) = SearchArray '結果出力
        
    End Sub

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

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

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

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

Sub Sample3()
    
    Dim SearchArray As Variant
    Dim RefArray()  As Variant
    Dim MaxRow      As Long
    Dim i           As Long
    Dim myStr       As String
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    MaxRow = Cells(Rows.Count, 1).End(xlUp).Row '最終行を取得
    
    For i = 2 To MaxRow
    
        Cells(i, 3) = "=COUNTIFS($E$2:$E$200001,A" & i & ",$F$2:$F$200001,B" & i & ")" '「”」を文字列として扱う
    
    Next i
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    End Sub

4.サンプルファイルダウンロード

こちらから今回使用したサンプルファイルをダウンロードできます。

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