VBAで個数を数える3つの方法【CountIf・入れ子ループ・Dictionary】

今の会社に転職してからVBAで業務を効率化する機会が増えました。もともとVBAはまったく分からない状態でしたが、実務で必要に迫られて少しずつ書けるようになりました。

先日、同僚にVBAを教える機会があり、「各項目の個数を数える」という処理を題材にしました。方法はいくつか考えられるので、代表的な3つを整理します。

①WorksheetFunction.CountIfを使う方法
②Forループの入れ子で数える方法
③Dictionary（連想配列）を使う方法
④処理速度を実測してみた
まとめ：どの方法を使うべきか

①WorksheetFunction.CountIfを使う方法

今回、同僚に実際に教えたのはこの方法です。Forループが1つで済むため、VBA初心者でも理解しやすいのが利点です。

Sub CountItems()
    Dim ws As Worksheet
    Dim i As Long
    Dim lastRow As Long
 
    Set ws = ThisWorkbook.Sheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
 
    ' A列の項目リストに対してB列に個数を書き出す
    For i = 2 To lastRow
        ws.Cells(i, 2).Value = WorksheetFunction.CountIf(ws.Range("D:D"), ws.Cells(i, 1).Value)
    Next i
End Sub

A列に並んだ項目それぞれについて、D列の中にいくつ含まれるかをCountIfで数え、B列に書き出しています。いきなりループの入れ子を教えるより、まずこの形から入る方が飲み込みやすいです。

VBAのCountItemsマクロを実行し、B列に各項目の個数が書き出された結果

②Forループの入れ子で数える方法

最初に思いつく人が多いのがこの方法です。自分ではあまり使いませんが、実務でVBAを書いていれば入れ子のForループには必ず出くわすので、いずれは教えたい書き方です。

Sub CountItemsNested()
    Dim ws As Worksheet
    Dim i As Long, j As Long
    Dim lastRowList As Long, lastRowData As Long
 
    Set ws = ThisWorkbook.Sheets("Sheet1")
    lastRowList = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    lastRowData = ws.Cells(ws.Rows.Count, 4).End(xlUp).Row
 
    ' 検索元リスト（A列）の各項目について
    For i = 2 To lastRowList
        ' 検索先データ（D列）をループして一致したらセルに1を足す
        For j = 2 To lastRowData
            If ws.Cells(j, 4).Value = ws.Cells(i, 1).Value Then
                ws.Cells(i, 2).Value = ws.Cells(i, 2).Value + 1
            End If
        Next j
    Next i
End Sub

検索元リストを1件ずつ外側のループで回し、内側のループで検索先データ全体と照合して、一致するたびにセルへ1を足していきます。セルに直接加算する形なら、変数はi・jの2つだけで済みます。

このコードはB列に「加算」していく処理です。①や③のような「上書き」ではないため、前回の実行結果が残ったままもう一度実行すると、個数が二重にカウントされてしまいます。複数回試す場合は、実行前にB列をクリアしてください。

B列をクリアせずにCountItemsNestedを実行し、個数が2倍にカウントされてしまった例

③Dictionary（連想配列）を使う方法

普段、自分で使うのはこの方法です。連想配列という考え方に最初は戸惑いましたが、仕組みを理解してからはほぼこれを使うようになりました。

Sub CountItemsDict()
    Dim ws As Worksheet
    Dim dict As Object
    Dim i As Long, lastRow As Long
    Dim key As Variant
 
    Set ws = ThisWorkbook.Sheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, 4).End(xlUp).Row
 
    Set dict = CreateObject("Scripting.Dictionary")
 
    ' D列のデータをDictionaryに集計
    For i = 2 To lastRow
        key = ws.Cells(i, 4).Value
        If dict.exists(key) Then
            dict(key) = dict(key) + 1
        Else
            dict.Add key, 1
        End If
    Next i
 
    ' 結果をA列・B列に書き出す
    i = 2
    For Each key In dict.Keys
        ws.Cells(i, 1).Value = key
        ws.Cells(i, 2).Value = dict(key)
        i = i + 1
    Next key
 
    Set dict = Nothing
End Sub

D列のデータを1回ループするだけで集計できるのが特徴です。①②のように事前に項目リスト（A列）を用意しなくても、データの中に出てきた項目をDictionaryが自動的にキーとして拾ってくれます。ただし連想配列という考え方そのものを理解していないと使いこなせないので、初心者に教える順番としては後回しになります。詳しい仕様はMicrosoft LearnのDictionaryオブジェクトのページにまとまっています。

VBAのCountItemsDictマクロを実行し、Dictionaryで集計した項目と個数がA列・B列に書き出された結果

VBEでCountItemsDictをステップ実行し、実行中の行が黄色くハイライトされている画面

④処理速度を実測してみた

3つの方法で処理速度がどれくらい違うか、実際に計測しました。項目200種類・データ5,000件と、実務に近い20万件の2パターンで比較しています。②はセルに1件ずつ書き込む元のコードのまま計測すると、セルへの読み書き回数の多さが響いて極端に遅くなったため、比較表ではいったん配列にためてから最後にまとめて書き出す形に直して計測しています。

方法	5,000件	20万件
①CountIf	0.09秒	2.95秒
②入れ子ループ（配列化・一括書き出し）	0.11秒	4.89秒
③Dictionary	0.03秒	1.08秒

②は最初、セルに1件ずつ書き込む元のコードのまま5,000件で計測したところ約7.8秒かかりました。ところが集計をいったん配列にためて最後に一括で書き出す形に直すと、同じ5,000件で0.1秒ほどまで縮みます。つまり②が遅くなる原因の多くは「ループの回数」そのものより「セルへの読み書きの回数」にありました。

ただし、配列化した②でも20万件になると①③よりはっきり遅くなります。これは②が項目数×データ件数の分だけ比較を繰り返す仕組みだからです（200項目×20万件で4,000万回の比較）。①と③はデータを基本1回なめるだけの処理なので、件数が増えても伸び方がゆるやかです。