Excel VBA 逆引き集 | 実務テンプレ完全版（超再利用部品） – マスタ結合×集計一括テンプレ

Excel VBA
スポンサーリンク

ねらい：明細にマスタを結合してから、即座に集計まで一括で完了させる

「明細＋マスタ結合→グループ集計→並べ替え→出力」をひとつのパイプラインにすると、10万行規模でも数秒で終わり、手作業や関数の脆さから解放されます。核は“配列I/O＋Dictionary＋正規化”です。初心者でも貼って動くテンプレを、JOIN（LEFT/INNER）と集計（合計・件数・平均・クロス）までまとめて解説します。

共通基盤：配列I/O・キー正規化・列指定

一括読み書き・キー生成・返却列指定

' ModBase.bas
Option Explicit
Private Const SEP As String = Chr$(30) ' 複合キーの安全な区切り

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

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

Public Function NormKey(ByVal v As Variant) As String
    NormKey = LCase$(Trim$(CStr(v))) ' 大文字小文字・前後空白の揺らぎを除去
End Function

Public Function ColsToIndex(ByVal csv As String) As Long()
    Dim p() As String: p = Split(csv, ",")
    Dim idx() As Long: ReDim idx(0 To UBound(p))
    Dim i As Long
    For i = 0 To UBound(p): idx(i) = Range(Trim$(p(i)) & "1").Column: Next
    ColsToIndex = idx
End Function
VB

重要ポイントの深掘り

  • ヘッダ扱い: 1行目はヘッダ固定、2行目からデータ。事故が激減します。
  • 正規化: 辞書登録時・参照時の両方で NormKey を通し、揺らぎによるヒット漏れを根絶します。
  • 列指定: 返却・比較列は文字指定（”B,D,F”）で、列追加や入替に強くします。

マスタ結合テンプレ：LEFT/INNERで属性を付与

LEFT JOIN（単一キー、複数列付与）

' ModJoin_Left.bas
Option Explicit

' detail: A=キー, B以降=明細
' master: A=キー, 返却列は colsCsv（例 "B,D"）
' outStart: 出力先（例 "Z1"）
Public Sub LeftJoinAdd(ByVal detail As String, ByVal master As String, ByVal outStart As String, ByVal colsCsv As String, Optional ByVal missingVal As Variant = "")
    Dim aD As Variant: aD = ReadRegion(Worksheets(detail))
    Dim aM As Variant: aM = ReadRegion(Worksheets(master))
    Dim retIdx() As Long: retIdx = ColsToIndex(colsCsv)

    ' master辞書：key→行番号
    Dim dM As Object: Set dM = CreateObject("Scripting.Dictionary"): dM.CompareMode = 1
    Dim r As Long: For r = 2 To UBound(aM, 1): dM(NormKey(aM(r, 1))) = r: Next

    ' 出力配列（左のキーを除いた列＋マスタ返却列）
    Dim outCols As Long: outCols = (UBound(aD, 2) - 1) + (UBound(retIdx) + 1)
    Dim out() As Variant: ReDim out(1 To UBound(aD, 1), 1 To outCols)

    ' ヘッダ
    Dim w As Long: w = 0: Dim c As Long
    For c = 2 To UBound(aD, 2): w = w + 1: out(1, w) = aD(1, c): Next
    For c = 0 To UBound(retIdx): w = w + 1: out(1, w) = Worksheets(master).Cells(1, retIdx(c)).Value: Next

    ' データ（左は必ず出す）
    For r = 2 To UBound(aD, 1)
        w = 0
        For c = 2 To UBound(aD, 2): w = w + 1: out(r, w) = aD(r, c): Next
        Dim k As String: k = NormKey(aD(r, 1))
        If dM.Exists(k) Then
            Dim rr As Long: rr = dM(k)
            Dim j As Long
            For j = 0 To UBound(retIdx): w = w + 1: out(r, w) = aM(rr, retIdx(j)): Next
        Else
            Dim j As Long
            For j = 0 To UBound(retIdx): w = w + 1: out(r, w) = missingVal: Next
        End If
    Next
    WriteBlock Worksheets(detail), out, outStart
End Sub
VB

INNER JOIN（一致行のみ抽出）

' ModJoin_Inner.bas
Option Explicit

Public Sub InnerJoinExtract(ByVal detail As String, ByVal master As String, ByVal outStart As String, ByVal colsCsv As String)
    Dim aD As Variant: aD = ReadRegion(Worksheets(detail))
    Dim aM As Variant: aM = ReadRegion(Worksheets(master))
    Dim retIdx() As Long: retIdx = ColsToIndex(colsCsv)

    Dim dM As Object: Set dM = CreateObject("Scripting.Dictionary"): dM.CompareMode = 1
    Dim r As Long: For r = 2 To UBound(aM, 1): dM(NormKey(aM(r, 1))) = r: Next

    ' ヘッダ（左キー除外＋右返却）
    Dim outCols As Long: outCols = (UBound(aD, 2) - 1) + (UBound(retIdx) + 1)
    Dim out() As Variant: ReDim out(1 To 1, 1 To outCols)
    Dim w As Long: w = 0: Dim c As Long
    For c = 2 To UBound(aD, 2): w = w + 1: out(1, w) = aD(1, c): Next
    For c = 0 To UBound(retIdx): w = w + 1: out(1, w) = Worksheets(master).Cells(1, retIdx(c)).Value: Next

    Dim rowsOut As Long: rowsOut = 1
    For r = 2 To UBound(aD, 1)
        Dim k As String: k = NormKey(aD(r, 1))
        If dM.Exists(k) Then
            rowsOut = rowsOut + 1: ReDim Preserve out(1 To rowsOut, 1 To outCols)
            w = 0
            For c = 2 To UBound(aD, 2): w = w + 1: out(rowsOut, w) = aD(r, c): Next
            Dim rr As Long: rr = dM(k)
            Dim j As Long
            For j = 0 To UBound(retIdx): w = w + 1: out(rowsOut, w) = aM(rr, retIdx(j)): Next
        End If
    Next
    WriteBlock Worksheets(detail), out, outStart
End Sub
VB

重要ポイントの深掘り

  • 欠損値の統一: 空/0/N/Aのどれにするか最初に決める。下流のピボットを壊さない値で統一。
  • 重複キー: 右側に重複がある場合の方針（最初/最後/全件展開）を仕様化。末尾採用なら「上書き辞書」で簡潔に実装できます。

集計テンプレ：グループ合計・件数・平均／クロス集計

キー別の合計・件数・平均

' ModAgg_Group.bas
Option Explicit

' src: A=キー, B=数値（例：金額）
' outStart: 出力先
Public Sub GroupSumCountAvg(ByVal src As String, ByVal outStart As String)
    Dim a As Variant: a = ReadRegion(Worksheets(src))
    Dim sumD As Object: Set sumD = CreateObject("Scripting.Dictionary"): sumD.CompareMode = 1
    Dim cntD As Object: Set cntD = CreateObject("Scripting.Dictionary"): cntD.CompareMode = 1

    Dim r As Long
    For r = 2 To UBound(a, 1)
        Dim k As String: k = NormKey(a(r, 1))
        Dim v As Double: v = Val(CStr(a(r, 2)))
        sumD(k) = IIf(sumD.Exists(k), sumD(k) + v, v)
        cntD(k) = IIf(cntD.Exists(k), cntD(k) + 1, 1)
    Next

    Dim out() As Variant: ReDim out(1 To sumD.Count + 1, 1 To 4)
    out(1, 1) = a(1, 1): out(1, 2) = "Sum": out(1, 3) = "Count": out(1, 4) = "Avg"

    Dim i As Long: i = 2
    Dim k As Variant
    For Each k In sumD.Keys
        out(i, 1) = k
        out(i, 2) = sumD(k)
        out(i, 3) = cntD(k)
        out(i, 4) = IIf(cntD(k) > 0, sumD(k) / cntD(k), 0)
        i = i + 1
    Next
    WriteBlock Worksheets(src), out, outStart
End Sub
VB

クロス集計（カテゴリ×月の合計）

' ModAgg_Pivot.bas
Option Explicit

' src: A=カテゴリ, B=月, C=金額
Public Sub PivotSum(ByVal src As String, ByVal outStart As String)
    Dim a As Variant: a = ReadRegion(Worksheets(src))
    Dim cats As Object: Set cats = CreateObject("Scripting.Dictionary"): cats.CompareMode = 1
    Dim months As Object: Set months = CreateObject("Scripting.Dictionary"): months.CompareMode = 1
    Dim r As Long
    For r = 2 To UBound(a, 1)
        cats(NormKey(a(r, 1))) = True
        months(NormKey(a(r, 2))) = True
    Next
    Dim map As Object: Set map = CreateObject("Scripting.Dictionary"): map.CompareMode = 1
    For r = 2 To UBound(a, 1)
        Dim k As String: k = NormKey(a(r, 1)) & SEP & NormKey(a(r, 2))
        Dim v As Double: v = Val(CStr(a(r, 3)))
        map(k) = IIf(map.Exists(k), map(k) + v, v)
    Next

    Dim mKeys() As Variant: mKeys = months.Keys
    Dim cKeys() As Variant: cKeys = cats.Keys

    Dim out() As Variant: ReDim out(1 To cats.Count + 1, 1 To months.Count + 1)
    out(1, 1) = "Category"
    Dim c As Long: For c = 0 To UBound(mKeys): out(1, c + 2) = mKeys(c): Next

    Dim i As Long: i = 2
    Dim j As Long
    For j = 0 To UBound(cKeys)
        Dim cat As String: cat = cKeys(j)
        out(i, 1) = cat
        For c = 0 To UBound(mKeys)
            Dim k As String: k = cat & SEP & mKeys(c)
            out(i, c + 2) = IIf(map.Exists(k), map(k), 0)
        Next
        i = i + 1
    Next
    WriteBlock Worksheets(src), out, outStart
End Sub
VB

重要ポイントの深掘り

  • 数値化: Val/CDblで必ず数値化。文字数値のままだと平均・並べ替えで破綻します。
  • 欠損: クロス集計の空セルはゼロで統一。後段の合算・グラフが安定します。

一括テンプレ：結合→集計のパイプライン（例題付き）

パイプライン実行（顧客明細＋顧客マスタ→売上合計）

' ModPipeline_JoinAgg.bas
Option Explicit

Public Sub Run_JoinThenAggregate()
    ' 1) マスタ結合：明細（Detail）A=顧客ID, B=日付, C=金額
    '    マスタ（Master）A=顧客ID, B=顧客名, D=カテゴリ（Cは他用途）
    LeftJoinAdd "Detail", "Master", "Z1", "B,D", "" ' 顧客名・カテゴリ付与（欠損は空）
    ' → 出力は Detail シートの Z1 から（明細＋顧客名＋カテゴリ）

    ' 2) 集計：顧客別の売上合計・件数・平均（結合出力を対象にする場合は適宜範囲指定）
    '    ここでは簡単に元明細の顧客IDと金額で集計（A=顧客ID, C=金額）
    GroupSumCountAvg "Detail", "AA1"

    ' 3) クロス集計：カテゴリ×月の金額合計（結合済み列を使って）
    '    例：カテゴリ（Z列）× 月（B列）× 金額（C列）を別シートに出力したい場合は
    '    必要に応じて結合結果を別シートへコピーしてから PivotSum を適用
    '    PivotSum "Detail", "AC1" ' 列構成に合わせて利用

    MsgBox "マスタ結合×集計パイプラインが完了しました。", vbInformation
End Sub
VB

重要ポイントの深掘り

  • 結合の出口を固定: 出力開始セル（例：Z1）を固定しておくと、下流が参照しやすく安定します。
  • 集計対象の列確認: 結合後の列位置に合わせ、集計関数の入力列（キー・数値）を誤らないようにします。
  • 段階ごとに配列中心: JOINも集計も“配列で完結→一括書き戻し”。逐次セル書きは避けます。

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

正規化不足でヒット漏れ・グループ割れ

  • 対策: NormKey（Trim/LCase）を辞書登録時・参照時の両方に適用。必要なら全半角統一の前処理を追加。

欠損の扱いが曖昧で下流が壊れる

  • 対策: 欠損は空/0/N/Aのいずれかに統一。集計やクロスではゼロ埋めが無難。

右側重複キーで結果が揺れる

  • 対策: 「最初/最後/全件展開/集約」方針を仕様化。末尾採用なら上書き辞書で簡潔に表現。

列追加・入替でコードが壊れる

  • 対策: 返却列は文字指定（”B,D,F”）。ヘッダは1行目固定、出力開始セルを運用で決めておく。

セル逐次書きで遅い・固まる

  • 対策: 結果は配列で作成し、一括書き戻し。10万行でもUIが固まりません。

まとめ：配列I/O＋辞書化＋正規化で、結合から集計まで“速く・壊れない”一括処理に

  • 明細にマスタ属性を付与（LEFT/INNER）し、すぐにグループ集計・クロス集計へ。
  • 欠損・重複・列変更への耐性を設計時に固定し、配列一括書き戻しで速度を確保。
  • この型にすると、毎日でも安心して回せます。結合後の列設計に合わせて、集計テンプレを差し替えるだけで拡張可能です。

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