Excel VBA 逆引き集 | 異常値の検出

Excel VBA
スポンサーリンク

異常値の検出

異常値は「常識的な範囲外の値」「平均から極端に離れた値」「分布の外側（箱ひげ基準）」など定義で取り方が変わります。初心者でも安心して使える、ルール閾値・Zスコア・IQR（箱ひげ）・移動基準の4方式を、実務テンプレと例題でまとめます。

選び方の指針

  • まずは簡単に弾きたい: 固定の上下限（ルール閾値）
  • 分布基準で汎用的に: Zスコア（平均±kσ）
  • 外れ値に強い: IQR法（Q1−1.5IQR, Q3＋1.5IQR）
  • 時系列の突発検知: 移動平均/移動中央値＋乖離

ルール閾値（上下限）の最短テンプレ

Sub Detect_Thresholds()
    Dim last As Long: last = Cells(Rows.Count, "B").End(xlUp).Row 'B列が対象
    Dim low As Double: low = 0
    Dim high As Double: high = 100000

    Dim r As Long
    For r = 2 To last
        Dim x As Double: x = Val(Cells(r, "B").Value)
        If x < low Or x > high Then
            Cells(r, "B").Interior.Color = RGB(255, 200, 200) '赤背景
            Cells(r, "C").Value = "閾値外"                    'C列にフラグ
        End If
    Next
End Sub
VB
  • ポイント:
    • 仕様が明確な範囲（例：数量は0以上、金額は10万以下）に向く。
    • 閾値は後から変更できるよう定数化しておくと楽。

Zスコア（平均±kσ）で異常値検出

Sub Detect_ZScore()
    Dim rng As Range: Set rng = Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
    Dim mu As Double: mu = Application.WorksheetFunction.Average(rng)
    Dim sd As Double: sd = Application.WorksheetFunction.StDev(rng)   '標本標準偏差
    If sd = 0 Then MsgBox "標準偏差が0のため判定不可": Exit Sub

    Dim k As Double: k = 3  '3σルール
    Dim r As Range
    For Each r In rng
        Dim z As Double: z = (Val(r.Value) - mu) / sd
        If Abs(z) >= k Then
            r.Interior.Color = RGB(255, 235, 156)
            r.Offset(0, 1).Value = "Z≥" & k
        End If
    Next
End Sub
VB
  • ポイント:
    • 分布が概ね正規に近いときに有効。
    • kは2～3が実務の目安。sd=0の場合は全値同一なので判定できない。

IQR法（箱ひげ: Q1−1.5IQR, Q3＋1.5IQR）

Sub Detect_IQR()
    Dim rng As Range: Set rng = Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
    Dim q1 As Double: q1 = Application.WorksheetFunction.Quartile_Inc(rng, 1)
    Dim q3 As Double: q3 = Application.WorksheetFunction.Quartile_Inc(rng, 3)
    Dim iqr As Double: iqr = q3 - q1
    Dim low As Double: low = q1 - 1.5 * iqr
    Dim high As Double: high = q3 + 1.5 * iqr

    Dim r As Range
    For Each r In rng
        Dim x As Double: x = Val(r.Value)
        If x < low Or x > high Then
            r.Font.Bold = True
            r.Offset(0, 1).Value = "IQR外"
        End If
    Next
End Sub
VB
  • ポイント:
    • 外れ値の影響を受けない堅牢な方法。分布が歪んでいても扱いやすい。
    • Excelの環境によっては Quartile_Inc が使えない場合、Percentile_Inc で25%・75%を代替可能。

移動平均/移動中央値＋乖離率（時系列の突発検知）

Sub Detect_RollingDeviation()
    Dim last As Long: last = Cells(Rows.Count, "B").End(xlUp).Row
    Dim window As Long: window = 7          '7件移動
    Dim tol As Double: tol = 0.3            '30%乖離を異常扱い

    Dim r As Long
    For r = 2 + window To last
        Dim base As Double: base = Application.WorksheetFunction.Median(Range(Cells(r - window, "B"), Cells(r - 1, "B")))
        Dim x As Double: x = Val(Cells(r, "B").Value)
        If base > 0 Then
            Dim dev As Double: dev = Abs(x - base) / base
            If dev >= tol Then
                Cells(r, "B").Interior.Color = RGB(200, 255, 200)
                Cells(r, "C").Value = "移動基準外"
            End If
        End If
    Next
End Sub
VB
  • ポイント:
    • 急激なスパイク/ドロップを検知。平均より中央値が外れ値に強く安定。
    • tolは用途に応じて10～50%程度で調整。

爆速版：配列で一括計算→まとめて書き戻し

Sub Detect_IQR_ArrayFast()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    Dim rng As Range: Set rng = Range("B1").CurrentRegion.Columns(2) 'B列
    Dim v As Variant: v = rng.Value

    Dim q1 As Double: q1 = Application.WorksheetFunction.Quartile_Inc(rng.Offset(1, 0).Resize(rng.Rows.Count - 1), 1)
    Dim q3 As Double: q3 = Application.WorksheetFunction.Quartile_Inc(rng.Offset(1, 0).Resize(rng.Rows.Count - 1), 3)
    Dim iqr As Double: iqr = q3 - q1
    Dim low As Double: low = q1 - 1.5 * iqr
    Dim high As Double: high = q3 + 1.5 * iqr

    Dim i As Long
    For i = 2 To UBound(v, 1)
        Dim x As Double: x = Val(v(i, 1))
        If x < low Or x > high Then
            'フラグ列（隣のC列に出す例）
            Cells(rng.Row + i - 1, rng.Column + 1).Value = "IQR外"
        End If
    Next

Cleanup:
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
VB
  • ポイント:
    • 範囲→配列→判定→必要箇所だけ書き戻しで高速化。
    • フォーマット変更（色付け）は Union 集合化→一括適用にするとさらに速い。

異常値の可視化（条件付き書式で補助）

Sub Visualize_WithCF()
    With Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
        .FormatConditions.Delete
        '上位1%を赤、下位1%を青（簡易）
        .FormatConditions.AddTop10
        .FormatConditions(.FormatConditions.Count).TopBottom = xlTop10Top
        .FormatConditions(.FormatConditions.Count).Rank = 1
        .FormatConditions(.FormatConditions.Count).Percent = True
        .FormatConditions(.FormatConditions.Count).Interior.Color = RGB(255, 200, 200)

        .FormatConditions.AddTop10
        .FormatConditions(.FormatConditions.Count).TopBottom = xlTop10Bottom
        .FormatConditions(.FormatConditions.Count).Rank = 1
        .FormatConditions(.FormatConditions.Count).Percent = True
        .FormatConditions(.FormatConditions.Count).Interior.Color = RGB(200, 200, 255)
    End With
End Sub
VB
  • ポイント:
    • コードを書かずに視覚的に外れを確認したいときに役立つ簡易法。

よくある落とし穴と対策

  • 元データに文字列や空白が混じる
    • 対策: Valで数値化、前処理でTrim/数値チェック（IsNumeric）を行う。
  • 標準偏差が0でZスコア不可
    • 対策: すべて同一値ならZスコアは無意味。IQR法や閾値法へ切り替える。
  • 極端な外れ値が平均やσを歪める
    • 対策: IQR法や移動中央値を使う。必要なら外れ値を除いて再推定。
  • 時系列の季節性で誤検知
    • 対策: 週次/月次など周期に合わせて窓幅を設定、または同曜日比較に変更。
  • 演算対象の範囲がずれている
    • 対策: CurrentRegionや見出し位置の自動取得で範囲を固定化。

例題で練習

'例1：B列をZスコア3σでマーキング
Sub Example_Z3Sigma()
    Call Detect_ZScore
End Sub

'例2：B列をIQR法でフラグ付け、C列に「IQR外」
Sub Example_IQRFlag()
    Call Detect_IQR
End Sub

'例3：B列の7件移動中央値から30%乖離を検知
Sub Example_RollingMedian()
    Call Detect_RollingDeviation
End Sub
VB
スポンサーリンク
タイトルとURLをコピーしました