Excel VBA 逆引き集 | 実務テンプレ完全版（超再利用部品） – 分析テンプレ（前日比など）

Excel VBA
スポンサーリンク

ねらい：売上・アクセスなどの「前日比・前週比・移動平均・異常検知」を一撃で出せる分析テンプレ

毎日の数字を「昨日と比べる」「先週同曜日と比べる」「短期の傾向を見る」「急増急減を検知する」までを一括で回せると、意思決定が速くブレません。VBAなら“日付キー→整形→集計→差分計算→見える化”の型にすると、列変更にも壊れず、初心者でも貼って動く分析テンプレが作れます。

入力と共通基盤：日付・値の整形、キー生成、配列I/O

シート構成と前提

  • Data（時系列明細）: A=日付, B=指標名（例：売上, 注文件数）, C=値
    例：行は「日付×指標」の縦持ち。指標は複数でもOK（売上と件数など）

日付は1行目ヘッダ固定、2行目からデータ。日付・数値が“正しい型”で扱えるよう入口で正規化します。

ユーティリティ（貼って動く最小セット）

' ModAnal_Base.bas
Option Explicit

Public Function ReadRegion(ws As Worksheet, Optional topLeft As String = "A1") As Variant
    ReadRegion = ws.Range(topLeft).CurrentRegion.Value
End Function

Public Sub WriteBlock(ws As Worksheet, a As Variant, startCell As String)
    ws.Range(startCell).Resize(UBound(a, 1), UBound(a, 2)).Value = a
End Sub

Public Function NormKey(v As Variant) As String
    NormKey = LCase$(Trim$(CStr(v)))
End Function

Public Function ToNumberOrZero(v As Variant) As Double
    If IsNumeric(v) Then ToNumberOrZero = CDbl(v) Else ToNumberOrZero = 0#
End Function

Public Function ToDateOrEmpty(v As Variant) As Variant
    If IsDate(v) Then ToDateOrEmpty = CDate(v) Else ToDateOrEmpty = ""
End Function

Public Sub FormatBlock(ws As Worksheet, startCell As String, Optional numberColsCsv As String = "")
    With ws.Range(startCell).CurrentRegion
        .Columns.AutoFit
        .Borders.LineStyle = xlContinuous
    End With
    If Len(numberColsCsv) > 0 Then
        Dim p() As String: p = Split(numberColsCsv, ",")
        Dim i As Long
        For i = LBound(p) To UBound(p)
            ws.Columns(Trim$(p(i))).NumberFormatLocal = "#,##0"
        Next
    End If
End Sub
VB

重要部分の深掘り

  • 前日比は「日付→値」のマップを作るのが基本。日付・数値の型が崩れると、差分計算が壊れます。入口で ToDateOrEmpty／ToNumberOrZero を通すだけで事故が激減します。
  • 出力は配列→一括貼り→書式一括適用。千区切り・罫線の標準化でレビューが速くなります。

整形と派生列：指標ごとに日次を揃える（空日は0で埋める）

日次フレームの作成（連続日付で整列）

' ModAnal_Frame.bas
Option Explicit

' Data: A=日付, B=指標名, C=値
' 出力：指標ごとに「日付×値」を連続日付で整列（空日は0）
Public Sub BuildDailyFrame(ByVal sheetName As String, ByVal outStart As String)
    Dim ws As Worksheet: Set ws = Worksheets(sheetName)
    Dim a As Variant: a = ReadRegion(ws)

    ' 日付範囲の特定
    Dim minD As Date, maxD As Date, r As Long
    minD = DateSerial(2100, 1, 1): maxD = DateSerial(1900, 1, 1)
    For r = 2 To UBound(a, 1)
        Dim dt As Variant: dt = ToDateOrEmpty(a(r, 1))
        If IsDate(dt) Then
            If dt < minD Then minD = dt
            If dt > maxD Then maxD = dt
        End If
    Next
    If maxD < minD Then MsgBox "日付データがありません。", vbExclamation: Exit Sub

    ' 指標の一覧
    Dim metrics As Object: Set metrics = CreateObject("Scripting.Dictionary"): metrics.CompareMode = 1
    For r = 2 To UBound(a, 1): metrics(NormKey(a(r, 2))) = True: Next

    ' 指標→(日付→値)マップ
    Dim map As Object: Set map = CreateObject("Scripting.Dictionary"): map.CompareMode = 1
    Dim k As Variant
    For Each k In metrics.Keys
        map(k) = CreateObject("Scripting.Dictionary"): map(k).CompareMode = 1
    Next
    For r = 2 To UBound(a, 1)
        Dim m As String: m = NormKey(a(r, 2))
        Dim d As Variant: d = ToDateOrEmpty(a(r, 1))
        Dim v As Double: v = ToNumberOrZero(a(r, 3))
        If IsDate(d) And map.Exists(m) Then map(m)(Format$(d, "yyyy-mm-dd")) = v
    Next

    ' 出力：行=連続日付、列=指標
    Dim days As Long: days = DateDiff("d", minD, maxD) + 1
    Dim out() As Variant: ReDim out(1 To days + 1, 1 To metrics.Count + 1)
    out(1, 1) = "Date"
    Dim c As Long: c = 2
    For Each k In metrics.Keys
        out(1, c) = k: c = c + 1
    Next

    Dim d As Date, i As Long: i = 2
    For d = minD To maxD
        out(i, 1) = d
        c = 2
        For Each k In metrics.Keys
            Dim key As String: key = Format$(d, "yyyy-mm-dd")
            out(i, c) = IIf(map(k).Exists(key), map(k)(key), 0#)
            c = c + 1
        Next
        i = i + 1
    Next

    WriteBlock ws, out, outStart
    FormatBlock ws, outStart
    ws.Range(outStart).EntireColumn.NumberFormatLocal = "yyyy-mm-dd"
End Sub
VB

重要部分の深掘り

  • 差分計算は“欠損日”があるとズレます。連続した日付フレームを作り、空日は0で埋めるのが安全。
  • 指標を列に展開し、行が日付の形にすれば、前日比や移動平均を列単位で一括計算できます。

前日比・前週比・移動平均・異常検知の計算

計算テンプレ（各指標を一括で）

' ModAnal_Calc.bas
Option Explicit

' frame: BuildDailyFrameで作った表（A=Date, B〜=各指標）
' 出力：指標ごとに YoY1D（前日比）、WoW（前週同曜日比）、MA7（7日移動平均）、ZScore（異常度）
Public Sub CalcDailyAnalytics(ByVal frameSheet As String, ByVal outStart As String)
    Dim ws As Worksheet: Set ws = Worksheets(frameSheet)
    Dim f As Variant: f = ReadRegion(ws)

    Dim rows As Long: rows = UBound(f, 1)
    Dim cols As Long: cols = UBound(f, 2)

    Dim out() As Variant: ReDim out(1 To rows, 1 To 1 + (cols - 1) * 4)
    out(1, 1) = "Date"

    ' ヘッダ作成
    Dim m As Long, hCol As Long: hCol = 2
    For m = 2 To cols
        out(1, hCol) = f(1, m) & "_前日比": hCol = hCol + 1
        out(1, hCol) = f(1, m) & "_前週比": hCol = hCol + 1
        out(1, hCol) = f(1, m) & "_MA7":   hCol = hCol + 1
        out(1, hCol) = f(1, m) & "_ZScore": hCol = hCol + 1
    Next

    Dim r As Long
    For r = 2 To rows
        out(r, 1) = f(r, 1)
        Dim baseCol As Long: baseCol = 2
        For m = 2 To cols
            Dim today As Double: today = ToNumberOrZero(f(r, m))
            Dim prev As Double: prev = IIf(r > 2, ToNumberOrZero(f(r - 1, m)), 0#)
            Dim prevW As Double: prevW = IIf(r > 8, ToNumberOrZero(f(r - 7, m)), 0#)

            ' 前日比（率）= (今日 - 昨日) / 昨日
            out(r, baseCol) = IIf(prev <> 0, (today - prev) / prev, 0#): baseCol = baseCol + 1

            ' 前週比（率）= (今日 - 先週同曜日) / 先週同曜日
            out(r, baseCol) = IIf(prevW <> 0, (today - prevW) / prevW, 0#): baseCol = baseCol + 1

            ' 7日移動平均
            Dim s As Double: s = 0#: Dim n As Long: n = 0
            Dim k As Long
            For k = Application.WorksheetFunction.Max(2, r - 6) To r
                s = s + ToNumberOrZero(f(k, m)): n = n + 1
            Next
            Dim ma7 As Double: ma7 = IIf(n > 0, s / n, 0#)
            out(r, baseCol) = ma7: baseCol = baseCol + 1

            ' ZScore（直近7日平均と標準偏差に対する今日の偏差）
            Dim mean As Double: mean = ma7
            Dim varSum As Double: varSum = 0#: Dim cnt As Long: cnt = 0
            For k = Application.WorksheetFunction.Max(2, r - 6) To r
                Dim x As Double: x = ToNumberOrZero(f(k, m))
                varSum = varSum + (x - mean) * (x - mean)
                cnt = cnt + 1
            Next
            Dim std As Double: std = IIf(cnt > 1, Sqr(varSum / (cnt)), 0#)
            out(r, baseCol) = IIf(std > 0, (today - mean) / std, 0#): baseCol = baseCol + 1
        Next
    Next

    WriteBlock ws, out, outStart
    FormatBlock ws, outStart
    ws.Range(outStart).EntireColumn.NumberFormatLocal = "yyyy-mm-dd"
    ' 率列はパーセント表示
    Dim lastCol As Long: lastCol = UBound(out, 2)
    Dim rng As Range: Set rng = ws.Range(outStart).Resize(rows, lastCol)
    Dim c As Long
    For c = 2 To lastCol
        If InStr(1, out(1, c), "比") > 0 Then rng.Columns(c).NumberFormatLocal = "0.0%"
        If InStr(1, out(1, c), "MA7") > 0 Then rng.Columns(c).NumberFormatLocal = "#,##0.0"
        If InStr(1, out(1, c), "ZScore") > 0 Then rng.Columns(c).NumberFormatLocal = "0.00"
    Next
End Sub
VB

重要部分の深掘り

  • 前日比・前週比は“分母ゼロ”に注意。分母が0なら0扱いにして異常な∞を出さない。
  • 移動平均は「最新含む過去7日」で算出。欠損日があっても、存在分で平均して滑らかに。
  • Zスコアは“平均からの標準偏差何個分”を示す異常度。±2以上で「有意な変化」として旗を立てやすくなります。

ダッシュボード：急増／急減のハイライト、指標選択、簡易グラフ

見える化テンプレ

' ModAnal_Dashboard.bas
Option Explicit

' frameSheet: 日次フレーム、calcSheet: 前日比などの計算結果
Public Sub BuildAnalyticsDashboard(ByVal frameSheet As String, ByVal calcSheet As String, ByVal outSheet As String)
    Dim wsF As Worksheet: Set wsF = Worksheets(frameSheet)
    Dim wsC As Worksheet: Set wsC = Worksheets(calcSheet)

    Dim f As Variant: f = ReadRegion(wsF)
    Dim c As Variant: c = ReadRegion(wsC)

    Dim ws As Worksheet
    On Error Resume Next: Set ws = Worksheets(outSheet): On Error GoTo 0
    If ws Is Nothing Then Set ws = Worksheets.Add: ws.Name = outSheet Else ws.Cells.Clear

    ' 最新日付の行を特定
    Dim lastRow As Long: lastRow = UBound(c, 1)

    ' 指標ごとの最新 前日比・前週比・ZScore
    Dim out() As Variant: ReDim out(1 To 1, 1 To 5)
    out(1, 1) = "Metric": out(1, 2) = "前日比": out(1, 3) = "前週比": out(1, 4) = "MA7": out(1, 5) = "ZScore"

    Dim cols As Long: cols = UBound(f, 2)
    Dim rows As Long: rows = 1
    Dim m As Long, baseCol As Long
    baseCol = 2
    For m = 2 To UBound(f, 2)
        rows = rows + 1: ReDim Preserve out(1 To rows, 1 To 5)
        out(rows, 1) = f(1, m)
        ' calcSheetの列インデックス算出（各指標4列ずつ）
        Dim blockStart As Long: blockStart = 2 + (m - 2) * 4
        out(rows, 2) = c(lastRow, blockStart)
        out(rows, 3) = c(lastRow, blockStart + 1)
        out(rows, 4) = c(lastRow, blockStart + 2)
        out(rows, 5) = c(lastRow, blockStart + 3)
    Next

    WriteBlock ws, out, "A1"
    FormatBlock ws, "A1"
    ws.Range("B2:C" & rows).NumberFormatLocal = "0.0%"
    ws.Range("D2:D" & rows).NumberFormatLocal = "#,##0.0"
    ws.Range("E2:E" & rows).NumberFormatLocal = "0.00"

    ' 条件付き書式：ZScoreの異常（±2以上）を赤/青で塗る
    With ws.Range("E2:E" & rows)
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:="=2"
        .FormatConditions(1).Interior.Color = RGB(255, 220, 220)
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlLessEqual, Formula1:="=-2"
        .FormatConditions(2).Interior.Color = RGB(220, 230, 255)
    End With

    ' 最新指標のトレンドグラフ（例：最初の指標）
    Dim metricCol As Long: metricCol = 2
    Dim rngSeries As Range: Set rngSeries = wsF.Range("A2").Resize(UBound(f, 1) - 1, 1).Offset(0, metricCol - 1).Resize(UBound(f, 1) - 1, 2) ' Date + Metric
    Dim ch As ChartObject: Set ch = ws.ChartObjects.Add(Left:=ws.Range("A1").Left, Top:=ws.Range("A1").Top + ws.Range("A1").CurrentRegion.Height + 10, Width:=480, Height:=260)
    With ch.Chart
        .ChartType = xlLine
        .HasTitle = True
        .ChartTitle.Text = "Trend: " & f(1, metricCol)
        .SeriesCollection.NewSeries
        .SeriesCollection(1).XValues = wsF.Range("A2").Resize(UBound(f, 1) - 1)
        .SeriesCollection(1).Values = wsF.Range(wsF.Cells(2, metricCol), wsF.Cells(UBound(f, 1), metricCol))
    End With
End Sub
VB

重要部分の深掘り

  • ダッシュボードは“最新値の前日比／前週比／MA7／Zスコア”を一覧にし、異常に色をつけるだけで十分使えます。
  • グラフは指標選択を後から拡張可能。最初は1指標の折れ線グラフで「スパイク／落ち込み」を視認化。

例題の通し方：フレーム→前日比など→ダッシュボード→一括実行

パイプライン実行テンプレ

' ModAnal_Example.bas
Option Explicit

Public Sub Run_DailyAnalytics()
    ' 1) 日次フレーム（空日を0で埋める）
    BuildDailyFrame "Data", "Z1"

    ' 2) 前日比・前週比・MA7・ZScoreの計算
    CalcDailyAnalytics "Data", "AA1"

    ' 3) ダッシュボード作成
    BuildAnalyticsDashboard "Data", "Data", "Anal_Dashboard" ' calcSheetも"Data"（AA1開始領域）を参照

    MsgBox "前日比などの分析テンプレが完了しました。", vbInformation
End Sub
VB

補足：ダッシュボードの第3引数で参照している計算領域は、同じシートにある「AA1開始の計算ブロック」を想定しています。シートを分けたい場合は、計算出力を別シートに書いてそのシート名を渡してください。

落とし穴と対策（深掘り）

欠損日で前日比がズレる

連続日付フレームを先に作り、空日は0で埋める。これで差分の分母が安定します。

分母ゼロで∞やNaN

前日比・前週比は“分母=0なら0扱い”に固定。異常な値を出さず、実務報告が安定します。

ノイズに引っ張られて誤検知

移動平均＋Zスコアの組み合わせで“平滑化＋異常度”の二段構え。Zスコアの閾値（±2/±3）は現場で調整。

指標追加で列ズレ

ヘッダ名（指標名）をそのまま使い、列順に依存しない形で生成。指標が増えても4列ブロック単位で計算を展開する設計に。

セル逐次の遅さ

配列で計算し、一括書き戻し。10万行でも短時間で完了し、UIが固まりません。

まとめ：日次フレーム→差分→平滑化→異常検知→見える化の型で“毎日の変化”を逃さない

日付を連続フレームにし、前日比・前週比で変化率を出し、移動平均で傾向を、Zスコアで異常を。これを毎日同じ型で回すだけで、スパイクや落ち込みの原因探しが速くなります。

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