Excel VBA 逆引き集 | AVERAGEIFS

Excel VBA
スポンサーリンク

AVERAGEIFS

複数条件で平均を出すなら、WorksheetFunction.AverageIfs が最短で堅実。部分一致や柔軟条件が必要なら配列ループ、カテゴリ別の平均なら辞書が強い。初心者向けに壊れにくいテンプレと例題をまとめます。

基本テンプレート：WorksheetFunction.AverageIfs をそのまま使う

Sub AverageIfs_Basic()
    '範囲例：A=部署、B=日付、C=レベル、D=金額
    Dim avgRange As Range, depR As Range, datR As Range, levR As Range
    Set avgRange = Range("D2:D10000")
    Set depR     = Range("A2:A10000")
    Set datR     = Range("B2:B10000")
    Set levR     = 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 avgVal As Double
    avgVal = Application.WorksheetFunction.AverageIfs( _
                avgRange, _
                depR, dept, _
                datR, ">=" & CLng(startD), _
                datR, "<=" & CLng(endD), _
                levR, level)

    Range("H2").Value = avgVal
End Sub
VB
  • ポイント:
    • 日付条件: ">=" & CLng(Date) のようにシリアル値で渡すと安定。
    • 複数条件: 「条件範囲, 条件」をペアで連続指定。
    • 空セルの扱い: average_rangeの空は無視され、全条件未一致ならエラーになるので安全側でガード推奨。

条件をセルから読み取り（運用しやすい可変条件）

Sub AverageIfs_FromCells()
    Dim avgR As Range, depR As Range, datR As Range, levR As Range
    Set avgR = 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 level As String: level = Range("F5").Value   'レベル

    On Error Resume Next
    Range("H2").Value = Application.WorksheetFunction.AverageIfs( _
                            avgR, depR, dept, datR, ">=" & CLng(startD), datR, "<=" & CLng(endD), levR, level)
    On Error GoTo 0
End Sub
VB
  • ポイント:
    • エラーガード: 条件未一致でエラーになるため On Error で安全に。

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

Sub AverageIfs_OR_Combine()
    Dim avgR As Range, depR As Range, datR As Range, levR As Range
    Set avgR = Range("D2:D200000")
    Set depR = Range("A2:A200000")
    Set datR = Range("B2:B200000")
    Set levR = Range("C2:C200000")

    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 sums As Double, counts As Long, i As Long
    For i = LBound(levels) To UBound(levels)
        '対象の値を取得（合計と件数の両方を取りたい場合は別途 COUNTIFS を併用でもOK）
        Dim rngFilt As Range
        'フィルタせずにAVERAGEIFSのみでの合成は難しいため、個別平均を「重み付き」で合成
        Dim avg As Double, cnt As Long
        On Error Resume Next
        avg = Application.WorksheetFunction.AverageIfs(avgR, depR, dept, datR, ">=" & CLng(startD), datR, "<=" & CLng(endD), levR, levels(i))
        cnt = Application.WorksheetFunction.CountIfs(depR, dept, datR, ">=" & CLng(startD), datR, "<=" & CLng(endD), levR, levels(i))
        On Error GoTo 0
        If cnt > 0 Then
            sums = sums + avg * cnt
            counts = counts + cnt
        End If
    Next
    If counts > 0 Then Range("H2").Value = sums / counts Else Range("H2").Value = CVErr(xlErrDiv0)
End Sub
VB
  • ポイント:
    • OR平均の正しい合成: 個別平均の単純平均ではなく、件数で重み付けして合成。

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

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

    Dim dept As String: dept = "営"                     '部分一致OK
    Dim startD As Date: startD = DateSerial(2025, 1, 1)
    Dim endD   As Date: endD   = DateSerial(2025, 1, 31)
    Dim levels As Object: Set levels = CreateObject("Scripting.Dictionary")
    levels("ERROR") = True: levels("WARN") = True
    Dim minAmt As Double: minAmt = 1000                '下限例

    Dim sumV As Double, 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 = UCase$(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(c) _
           And d >= minAmt Then
            sumV = sumV + d
            cnt = cnt + 1
        End If
    Next

    If cnt > 0 Then Range("H2").Value = sumV / cnt Else Range("H2").Value = CVErr(xlErrDiv0)
End Sub
VB
  • ポイント:
    • 部分一致・複雑条件を自在に書ける。
    • 0件対策: 件数ゼロなら割り算を避けてエラーを返すか、0を返す。

カテゴリ別の平均（辞書でグループ平均）

Sub Average_GroupBy()
    'A=部署、B=年月、C=レベル、D=金額
    Dim rg As Range: Set rg = Range("A1").CurrentRegion
    Dim v As Variant: v = rg.Value

    Dim sumMap As Object: Set sumMap = CreateObject("Scripting.Dictionary")
    Dim cntMap As Object: Set cntMap = CreateObject("Scripting.Dictionary")

    Dim i As Long, key As String
    For i = 2 To UBound(v, 1)
        key = UCase$(CStr(v(i, 1))) & "|" & Format$(v(i, 2), "yyyymm") & "|" & UCase$(CStr(v(i, 3)))
        If sumMap.Exists(key) Then
            sumMap(key) = sumMap(key) + Val(v(i, 4))
            cntMap(key) = cntMap(key) + 1
        Else
            sumMap.Add key, Val(v(i, 4))
            cntMap.Add key, 1
        End If
    Next

    '書き出し
    Dim k As Variant, rOut As Long: rOut = 2
    With Worksheets("平均集計")
        .Range("A1:D1").Value = Array("部署", "年月", "レベル", "平均")
        For Each k In sumMap.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 = sumMap(k) / cntMap(k)
            rOut = rOut + 1
        Next
    End With
End Sub
VB
  • ポイント:
    • 多軸の平均を一気に作るなら辞書の合計＋件数でOK。
    • 正規化: 大小文字や日付フォーマット統一で取りこぼし防止。

見た目で絞ってから平均（AutoFilter）

Sub FilterThenAverage()
    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, avgVal As Double
        On Error Resume Next
        Set vis = .Columns(4).SpecialCells(xlCellTypeVisible) 'D列の可視セル
        On Error GoTo 0
        If Not vis Is Nothing Then avgVal = Application.WorksheetFunction.Average(vis)
        Range("H2").Value = avgVal

        .AutoFilter
    End With
End Sub
VB
  • ポイント:
    • 目視で確認しながら平均を取りたいときに便利。
    • 解除忘れ防止: 最後に .AutoFilter で解除。

安全・高速ラップ（大量時は必須）

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
  • ポイント:
    • 前後停止→復帰で体感速度が改善。エラー時は必ず復帰させる。

よくある落とし穴と対策

  • 日付が文字列で一致しない
    • 対策: 条件は ">=" & CLng(Date) のようにシリアル渡し。セル側が文字列なら Date 型へ正規化。
  • OR条件の平均を単純平均してしまう
    • 対策: 個別平均の「重み付き合成」（件数で重み付け）にする。
  • 部分一致が必要
    • 対策: AVERAGEIFS は完全一致向け。配列ループで InStr/Like を使う。
  • 件数ゼロで割り算エラー
    • 対策: 分母ゼロをチェックして CVErr(xlErrDiv0) か 0 を返す。
  • 型揺れで取りこぼし
    • 対策: 文字列は UCase/CStr、日付は Date、数値は Val で統一。

例題で練習

'例1：営業×2025年1月×ERRORの平均金額をH2へ（AVERAGEIFS）
Sub Example_AverageIfs()
    Call AverageIfs_Basic
End Sub

'例2：営業（部分一致）×2025年1月×ERROR/WARN×金額>=1000 の平均（配列ループ）
Sub Example_FlexibleAverage()
    Call Average_ByLoop_Flexible
End Sub

'例3：部署×年月×レベルのグループ平均（辞書）
Sub Example_GroupAverage()
    Call Average_GroupBy
End Sub
VB
スポンサーリンク
タイトルとURLをコピーしました