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

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

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

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

高速化するコード以外にも、通常の「WorksheetFunction.CountIf」の記述方法について併せてご紹介したいと思います。

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

1.COUNTIF高速化の方法
3.VBAでCOUNTIFを高速にする方法
4.Application.WorksheetFunction.CountIfで処理
5.サンプルデータダウンロード
6.まとめ

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