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 Sub3.数式を直接埋め込む方法
最後に文字列として数式を、セルに直接埋め込む方法です。
少しでも処理速度を上げるために再計算と描画を停止しています。
こちらも同じく処理時間が約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 Sub4.サンプルファイルダウンロード
こちらから今回使用したサンプルファイルをダウンロードできます。
