Excel VBA 逆引き集 | COUNTIFS相当

Excel VBA
スポンサーリンク

COUNTIFS相当

「複数条件で件数を数える」は COUNTIFS をそのままVBAから呼ぶのが最短。部分一致や柔軟な条件が必要なら配列＋ループ、グルーピングなら辞書が強い。初心者向けに壊れにくいテンプレと例題をまとめます。

選び方の指針

  • 最短・安全: WorksheetFunction.CountIfs（Excel関数をVBAから呼ぶ）
  • 部分一致・柔軟条件: 配列に読み込んでループで自作判定
  • 多軸の集計（カテゴリ×期間など）: 辞書でカウント
  • 見た目で絞って件数だけ欲しい: AutoFilter＋可視セルのカウント

基本テンプレ：WorksheetFunction.CountIfs をそのまま使う

Sub CountIfs_Basic()
    '範囲例：A=部署、B=日付、C=レベル、D=金額
    Dim depR As Range, datR As Range, levR As Range, amtR As Range
    Set depR = Range("A2:A10000")
    Set datR = Range("B2:B10000")
    Set levR = Range("C2:C10000")
    Set amtR = Range("D2:D10000")

    Dim dept As String: dept = "営業"
    Dim startD As Date: startD = DateSerial(2025, 1, 1)
    Dim endD   As Date: endD   = DateSerial(2025, 1, 31)
    Dim level  As String: level = "ERROR"

    Dim cnt As Long
    cnt = Application.WorksheetFunction.CountIfs( _
              depR, dept, _
              datR, ">=" & CLng(startD), _
              datR, "<=" & CLng(endD), _
              levR, level)

    Range("H2").Value = cnt
End Sub
VB
  • ポイント:
    • 日付比較はシリアルで渡す: ">=" & CLng(startD) のように文字列条件で。
    • 条件は「範囲, 条件」のペアを続けて渡す。

1フィールドのOR条件（「ERROR」または「WARN」）を合算

Sub CountIfs_OR_OneField()
    Dim depR As Range, datR As Range, levR As Range
    Set depR = Range("A2:A100000")
    Set datR = Range("B2:B100000")
    Set levR = Range("C2:C100000")

    Dim dept As String: dept = "営業"
    Dim startD As Date: startD = DateSerial(2025, 1, 1)
    Dim endD   As Date: endD   = DateSerial(2025, 1, 31)
    Dim levels As Variant: levels = Array("ERROR", "WARN")

    Dim i As Long, cnt As Long
    For i = LBound(levels) To UBound(levels)
        cnt = cnt + Application.WorksheetFunction.CountIfs( _
                    depR, dept, datR, ">=" & CLng(startD), datR, "<=" & CLng(endD), levR, levels(i))
    Next
    Range("H2").Value = cnt
End Sub
VB
  • ポイント:
    • COUNTIFSは同一フィールドのORが苦手。値ごとに回して合算がシンプル。

柔軟条件：配列＋ループで COUNTIFS 相当を自作

Sub Count_ByLoop_Flexible()
    Dim rg As Range: Set rg = Range("A1").CurrentRegion '表全体
    Dim v As Variant: v = rg.Value                      '配列へ（高速の基本）

    Dim dept As String: dept = "営"                     'A列：部署（部分一致OK）
    Dim startD As Date: startD = DateSerial(2025, 1, 1) 'B列：日付
    Dim endD   As Date: endD   = DateSerial(2025, 1, 31)
    Dim levels As Object: Set levels = CreateObject("Scripting.Dictionary")
    levels("ERROR") = True: levels("WARN") = True       'C列：レベル（OR対応）
    Dim minAmt As Double: minAmt = 10000                'D列：金額（下限）

    Dim cnt As Long, i As Long
    For i = 2 To UBound(v, 1)                           'ヘッダー除外
        Dim a As String: a = CStr(v(i, 1))
        Dim b As Date:   b = v(i, 2)
        Dim c As String: c = CStr(v(i, 3))
        Dim d As Double: d = Val(v(i, 4))

        If InStr(1, a, dept, vbTextCompare) > 0 _
           And b >= startD And b <= endD _
           And levels.Exists(UCase$(c)) _
           And d >= minAmt Then
            cnt = cnt + 1
        End If
    Next

    Range("H2").Value = cnt
End Sub
VB
  • ポイント:
    • 部分一致や複合条件、大小文字無視など柔軟に書ける。
    • 範囲→配列→判定→結果のみ書き戻しで大量データも速い。

多軸のカウント（辞書でグループ集計）

Sub Count_GroupBy_CompositeKey()
    'A=部署、B=日付、C=レベル
    Dim rg As Range: Set rg = Range("A1").CurrentRegion
    Dim v As Variant: v = rg.Value

    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    Dim i As Long, key As String

    For i = 2 To UBound(v, 1)
        Dim dept As String: dept = UCase$(CStr(v(i, 1)))
        Dim ym As String: ym = Format$(v(i, 2), "yyyymm")
        Dim level As String: level = UCase$(CStr(v(i, 3)))
        key = dept & "|" & ym & "|" & level
        If dict.Exists(key) Then dict(key) = dict(key) + 1 Else dict.Add key, 1
    Next

    '結果の書き出し
    Dim k As Variant, rOut As Long: rOut = 2
    With Worksheets("集計")
        .Range("A1:C1").Value = Array("部署", "年月", "レベル")
        .Range("D1").Value = "件数"
        For Each k In dict.Keys
            Dim parts() As String: parts = Split(k, "|")
            .Cells(rOut, 1).Value = parts(0)
            .Cells(rOut, 2).Value = parts(1)
            .Cells(rOut, 3).Value = parts(2)
            .Cells(rOut, 4).Value = dict(k)
            rOut = rOut + 1
        Next
    End With
End Sub
VB
  • ポイント:
    • COUNTIFSでは作りづらい「カテゴリ×期間×レベル」などの一括集計が簡単。
    • キーは型揺れ防止のため UCase と Format で正規化。

見た目で絞ってから件数取得（AutoFilter）

Sub FilterThenCount()
    With Range("A1").CurrentRegion
        .AutoFilter Field:=1, Criteria1:="営業"                    '部署
        .AutoFilter Field:=3, Criteria1:=Array("ERROR","WARN"), Operator:=xlFilterValues 'レベル
        .AutoFilter Field:=2, Operator:=xlAnd, Criteria1:=">=1/1/2025", Criteria2:="<=1/31/2025" '期間

        Dim vis As Range, cnt As Long
        On Error Resume Next
        Set vis = .Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) 'データ行のみ
        On Error GoTo 0
        If Not vis Is Nothing Then cnt = vis.Areas(1).Rows.Count '単純件数（エリアに分かれる場合あり）

        Range("H2").Value = cnt
        .AutoFilter
    End With
End Sub
VB
  • ポイント:
    • 目視確認しながら件数を取りたいときの最短手。
    • 複数エリアに分割される場合は全AreasのRows.Count合計にする。

安全・高速ラップ（大量時の基本）

Sub SafeWrapStart()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
End Sub

Sub SafeWrapEnd()
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
VB
  • ポイント:
    • 前後停止→復帰で体感が大きく改善。失敗時も復帰できるように後始末を忘れない。

よくある落とし穴と対策

  • 日付が効かない（文字列日付）
    • 対策: COUNTIFSでは ">=" & CLng(Date) のようにシリアルで渡す。セルが文字列なら Date 型へ変換してから比較。
  • 同一フィールドのORを1回で書きたい
    • 対策: COUNTIFSは弱い。値ごとに回して合算、またはループ＋辞書で集計。
  • 部分一致が必要
    • 対策: COUNTIFSは完全一致向き。InStr/Like を使うループ法へ切り替える。
  • セル往復で遅い
    • 対策: 範囲→配列→判定→結果のみ書き戻し。辞書でグループ化するとさらに速い。
  • 型揺れ（”00123″ と 123 が別扱い）
    • 対策: 文字列は UCase/CStr、日付は Date、数値は Val に統一。連結キーは "|" などにして曖昧回避。

例題で練習

'例1：営業×2025年1月×ERROR の件数をH2へ（COUNTIFS）
Sub Example_CountIfs()
    Call CountIfs_Basic
End Sub

'例2：営業（部分一致）×2025年1月×ERROR/WARN×金額>=1万 の件数（ループ法）
Sub Example_FlexibleCount()
    Call Count_ByLoop_Flexible
End Sub

'例3：部署×年月×レベルの多軸カウント（辞書）
Sub Example_GroupCount()
    Call Count_GroupBy_CompositeKey
End Sub
VB

スポンサーリンク
タイトルとURLをコピーしました