Excel VBA COUNTIFの高速化

高速化

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

前回掲載したVLOOKUP関数同様、COUNTIF関数も非常に使用頻度の高い関数かと思います。

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

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

1.COUNTIF高速化の方法

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

Dictionaryでリストを作成する際にItemにカウントアップしていく方法を使用します。

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

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

3.VBAでCOUNTIFを高速にする方法

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

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

「Application.WorksheetFunction.CountIf 」のループで、処理した場合は約35分かかりました。(20分くらいを想定してました・・・。)

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

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

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

A列の5万個のデータが全て4回重複したデータです。

Sub Sample1()

        Dim SearchArray As Variant
        Dim RefArray    As Variant
        Dim Keyval      As String
        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, 4)) '②参照データとしてD列を格納
        
        Set myDic = CreateObject("Scripting.Dictionary")
        
        For n = 1 To UBound(RefArray) '参照用の配列を要素数分ループ
                            
            Keyval = RefArray(n, 1) '③Keyを格納
            
            '未登録の場合登録
            '登録済みの場合は+1カウントアップ
            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) = myDic(Keyval) '検索値のKeyでItemを抽出
        
        Next n
        
        Range(Cells(2, 1), Cells(MaxRowA, 2)) = SearchArray '結果出力
        
        Set myDic = Nothing
    
    End Sub

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

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

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

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

ポイントは格納時にすでに登録済みの場合はItemに+1カウントアップします。

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

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

4.Application.WorksheetFunction.CountIfで処理

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

上でも記載してますが、20分予定が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.CountIf(Range(Cells(2, 4), Cells(MaxRowD, 4)), myStr)
        
        Next i
        
        Range(Cells(2, 1), Cells(MaxRowA, 2)) = SearchArray '結果出力
        
    End Sub

5.サンプルデータダウンロード

掲載しているサンプルデータとSample1~2のVBAコードを記載したファイルです。

参照列とご自身の環境に合わせて頂くだけで使用できると思います。

6.まとめ

VLOOKUP関数の高速化ロジックとほとんど一緒ですが、Dictionaryを一工夫する事でCOUNTIF関数等も出来ます。

Dictionary以外はほとんど基本的な内容ですので、サンプルコードで不明点があれば「ExcelVBA-基礎編」をご覧ください。

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