SUMIFS相当
複数条件で合計する処理は「WorksheetFunction.SumIfs を直接呼ぶ」のが最短。大量データや柔軟条件が必要なら「配列＋ループ」や「辞書で集計」が堅牢で速いです。初心者向けに、壊れにくいテンプレと例題をまとめました。
選び方の指針
- 最短・安全: WorksheetFunction.SumIfs（Excel関数をVBAから呼ぶ）
- 柔軟な比較（関数では表現しづらい条件）: ループ＋If（配列で高速化）
- 大量データのグループ集計: 辞書（キーを複合条件にして合計）
- 見た目抽出後に合計: AutoFilter＋WorksheetFunction.Sum（手軽）
基本テンプレ：WorksheetFunction.SumIfs をそのまま使う
Sub SumIfs_Basic()
'範囲例：A列=部署、B列=日付、C列=レベル、D列=金額
Dim sumRange As Range, deptRange As Range, dateRange As Range, levelRange As Range
Set sumRange = Range("D2:D10000")
Set deptRange = Range("A2:A10000")
Set dateRange = Range("B2:B10000")
Set levelRange= Range("C2:C10000")
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 total As Double
total = Application.WorksheetFunction.SumIfs( _
sumRange, _
deptRange, dept, _
dateRange, ">=" & CLng(startD), _
dateRange, "<=" & CLng(endD), _
levelRange, level)
Range("H2").Value = total
End Sub
- ポイント:
- 日付比較はシリアルで渡す:
">=" & CLng(startD)のように文字列式で指定。 - 複数条件は「範囲, 条件」のペアを続けて渡す。
- テキスト一致はそのまま文字列でOK。部分一致は関数では対応外なので後述のループ法へ。
- 日付比較はシリアルで渡す:
応用：条件をセルから読み取って可変にする
Sub SumIfs_FromInputCells()
Dim sumR As Range, depR As Range, datR As Range, levR As Range
Set sumR = Range("D2:D100000")
Set depR = Range("A2:A100000")
Set datR = Range("B2:B100000")
Set levR = Range("C2:C100000")
Dim dept As String: dept = Range("F2").Value '部署
Dim startD As Date: startD = Range("F3").Value '開始日
Dim endD As Date: endD = Range("F4").Value '終了日
Dim levels As Variant: levels = Array("ERROR", "WARN") 'OR条件例
Dim total As Double, i As Long
For i = LBound(levels) To UBound(levels)
total = total + Application.WorksheetFunction.SumIfs( _
sumR, depR, dept, datR, ">=" & CLng(startD), datR, "<=" & CLng(endD), levR, levels(i))
Next
Range("H2").Value = total
End Sub
- ポイント:
- SUMIFSは1フィールドのOR条件が弱いので、配列で回して「合算」するのが簡単。
- 条件セルから読み取ると運用が楽。
柔軟条件：配列＋ループで「SUMIFS相当」を自作
Sub Sum_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 sumV As Double, i As Long
For i = 2 To UBound(v, 1) '2行目から（ヘッダー除外）
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
sumV = sumV + d
End If
Next
Range("H2").Value = sumV
End Sub
- ポイント:
- 部分一致や複雑条件（大小文字無視、範囲外除外など）を自在に書ける。
- 範囲→配列→一括判定→結果のみ書き戻しが高速。
大量データのグループ集計（辞書でSUMIFS風）
Sub Sum_GroupBy_CompositeKey()
'A=部署、B=日付、C=レベル、D=金額
Dim rg As Range: Set rg = Range("A1").CurrentRegion
Dim v As Variant: v = rg.Value
'グルーピングキー：部署 + 年月（yyyymm） + レベル
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) + Val(v(i, 4))
Else
dict.Add key, Val(v(i, 4))
End If
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
- ポイント:
- SUMIFSでは難しい「複数軸での一括グループ集計」が一瞬でできる。
- キーは型揺れ防止のため UCase などで正規化。
AutoFilterで絞ってから合計（見た目優先の最短）
Sub FilterThenSum()
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
On Error Resume Next
Set vis = .Columns(4).SpecialCells(xlCellTypeVisible) 'D列の可視セル
On Error GoTo 0
If Not vis Is Nothing Then
Range("H2").Value = Application.WorksheetFunction.Sum(vis)
End If
.AutoFilter '解除
End With
End Sub
- ポイント:
- 見た目で確認しながら合計を取りたいときに便利。
- フィルタ解除を忘れない。
安全・高速ラップ（大量時の基本）
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
- ポイント:
- 取り込み前後に挟むだけで体感速度が改善。失敗時も復帰できるよう
On Error GoTo Cleanupを併用。
- 取り込み前後に挟むだけで体感速度が改善。失敗時も復帰できるよう
よくある落とし穴と対策
- 日付条件がうまく効かない
- 対策: SUMIFSでは
">=" & CLng(date)のようにシリアル化して渡す。セルが文字列日付なら事前にDate型へ変換。
- 対策: SUMIFSでは
- OR条件（同じフィールドに複数値）
- 対策: SUMIFSを値ごとに回して合算、またはループ法で辞書に集計。
- 部分一致が必要
- 対策: SUMIFSは完全一致用。部分一致は配列＋InStrで自作判定へ。
- セル往復で遅い
- 対策: 範囲→配列→判定→一括書き戻しが鉄板。辞書でグループ化するとさらに速い。
- 型揺れで取りこぼし
- 対策: 文字列は
UCase/CStr、日付はDate、数値はValで正規化。連結キーは"|"など見出しにない文字で区切る。
- 対策: 文字列は
例題で練習
'例1：営業×2025年1月×ERRORの金額合計をH2へ（SUMIFS）
Sub Example_SumIfs()
Call SumIfs_Basic
End Sub
'例2：営業（部分一致）×2025年1月×ERROR/WARN×金額>=1万の合計（ループ法）
Sub Example_FlexibleSum()
Call Sum_ByLoop_Flexible
End Sub
'例3：部署×年月×レベルの多軸グループ集計（辞書）
Sub Example_GroupSum()
Call Sum_GroupBy_CompositeKey
End Sub