Excel VBA 逆引き集 | 実務テンプレ完全版（超再利用部品） – 拡張JOIN（1対多）

Excel VBA
スポンサーリンク

ねらい：VLOOKUPではできない「1対多JOIN」をVBAで“型”にする

ふつうのJOIN（VLOOKUP的なもの）は「1対1」です。
顧客コード → 顧客名、商品コード → 商品名、のように「1つのキーに1行だけ」対応している世界。

でも実務ではこういうのが出てきます。

顧客1人に対して、複数の注文行がある（顧客 → 注文明細）。
案件1件に対して、複数の担当者が紐づく（案件 → 担当者一覧）。
商品1つに対して、複数の価格履歴がある（商品 → 価格履歴）。

これは「1対多」の関係です。
VLOOKUPでは「最初の1件」しか取れないので、“全部の子レコードをJOINする”には向きません。

ここで作る「拡張JOIN（1対多）」テンプレは、

親テーブル（顧客など）
子テーブル（注文明細など）

を用意して、

親1行に対して、子を「縦に増やす」か「横にまとめる」か、
どちらのパターンもこなせる“汎用の型”を作ることが目的です。

全体設計：親テーブルと子テーブルをどう扱うか

想定するシート構成（例：顧客 → 注文明細）

例として、次のような構成を想定します。

Customers シート（親）

A列：CustomerID
B列：CustomerName

Orders シート（子）

A列：OrderID
B列：CustomerID
C列：OrderDate
D列：Amount

やりたいことは、次の2パターンです。

親1行を「縦に増やす」パターン
　→ 顧客1人に対して、注文明細を全部くっつけて、行を増やす（親×子の組み合わせを全部出す）。

親1行に「横にまとめる」パターン
　→ 顧客1人に対して、「注文日1・金額1」「注文日2・金額2」…のように横に展開する。

まずは、実務でよく使う「縦に増やす」パターンから作っていきます。

コア部品：子テーブルを「CustomerID → 子行の配列」にまとめる

子テーブルをDictionaryに載せる（1キーに複数行）

1対多JOINのキモは、「1つのキーに複数行をぶら下げる」ことです。
Dictionaryの値に「子行の配列（またはCollection）」を持たせます。

ここでは、分かりやすく Collection を使います。

' ModJoin_OneToMany.bas
Option Explicit

Private Type OrderRow
    OrderID As String
    OrderDate As Variant
    Amount As Double
End Type

Private Function LoadOrdersByCustomer() As Object
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Orders")
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = 1
    
    Dim r As Long
    Dim key As String
    Dim o As OrderRow
    Dim col As Collection
    
    For r = 2 To lastRow
        key = CStr(ws.Cells(r, 2).Value)   ' CustomerID（B列）
        If key <> "" Then
            o.OrderID = CStr(ws.Cells(r, 1).Value)
            o.OrderDate = ws.Cells(r, 3).Value
            o.Amount = CDbl(IIf(ws.Cells(r, 4).Value = "", 0, ws.Cells(r, 4).Value))
            
            If dict.Exists(key) Then
                Set col = dict(key)
            Else
                Set col = New Collection
                dict.Add key, col
            End If
            col.Add o
        End If
    Next
    
    Set LoadOrdersByCustomer = dict
End Function
VB

ここでの重要ポイントを深掘りします。

OrderRow というユーザー定義型で「1行分の子データ」をひとまとめにしている。
Dictionary の値は Collection にして、「その顧客の注文行を全部ぶら下げる」。
同じ CustomerID が出てきたら、既存の Collection に追加していく。

これで、dict("C001") を見ると、「C001 の全注文行」が Collection として取れる状態になります。

親×子を「縦に増やす」1対多JOINテンプレ

出力先シートの設計

結果は、Result シートに出すことにします。

Result

A列：CustomerID
B列：CustomerName
C列：OrderID
D列：OrderDate
E列：Amount

親1行に対して、子の件数分だけ行を増やして出力します。

親をなめながら、子を展開して書き出す

Public Sub Join_OneToMany_Vertical()
    Dim wsC As Worksheet, wsR As Worksheet
    Set wsC = ThisWorkbook.Worksheets("Customers")
    
    On Error Resume Next
    Set wsR = ThisWorkbook.Worksheets("Result")
    On Error GoTo 0
    If wsR Is Nothing Then
        Set wsR = ThisWorkbook.Worksheets.Add
        wsR.Name = "Result"
    Else
        wsR.Cells.Clear
    End If
    
    wsR.Range("A1:E1").Value = Array("CustomerID", "CustomerName", "OrderID", "OrderDate", "Amount")
    
    Dim dictOrders As Object
    Set dictOrders = LoadOrdersByCustomer()
    
    Dim lastRowC As Long
    lastRowC = wsC.Cells(wsC.Rows.Count, 1).End(xlUp).Row
    
    Dim rC As Long
    Dim outRow As Long
    outRow = 2
    
    Dim custID As String
    Dim custName As String
    Dim col As Collection
    Dim i As Long
    Dim o As OrderRow
    
    For rC = 2 To lastRowC
        custID = CStr(wsC.Cells(rC, 1).Value)
        custName = CStr(wsC.Cells(rC, 2).Value)
        
        If custID <> "" Then
            If dictOrders.Exists(custID) Then
                Set col = dictOrders(custID)
                For i = 1 To col.Count
                    o = col(i)
                    wsR.Cells(outRow, 1).Value = custID
                    wsR.Cells(outRow, 2).Value = custName
                    wsR.Cells(outRow, 3).Value = o.OrderID
                    wsR.Cells(outRow, 4).Value = o.OrderDate
                    wsR.Cells(outRow, 5).Value = o.Amount
                    outRow = outRow + 1
                Next
            Else
                wsR.Cells(outRow, 1).Value = custID
                wsR.Cells(outRow, 2).Value = custName
                wsR.Cells(outRow, 3).Value = ""
                wsR.Cells(outRow, 4).Value = ""
                wsR.Cells(outRow, 5).Value = 0
                outRow = outRow + 1
            End If
        End If
    Next
    
    wsR.Columns.AutoFit
    MsgBox "1対多JOIN（縦展開）が完了しました。", vbInformation
End Sub
VB

ここでの重要ポイントを整理します。

Customers を1行ずつ読む。
その CustomerID に対して、子Dictionaryに注文があれば、件数分だけ行を増やして書き出す。
子が1件もない顧客も、「注文なし」として1行だけ出す（ここは運用に応じて変えられる）。

この形は、SQLでいうところの「LEFT JOIN＋子側の複数行展開」に相当します。
ピボットや集計の前段として、「親×子の組み合わせを全部出したい」ときに非常に使えます。

例題イメージ：顧客別の全注文明細を1シートにまとめる

Customers

C001 佐藤商事
C002 鈴木工業

Orders

O001 C001 2024/01/01 10000
O002 C001 2024/01/05 15000
O003 C002 2024/01/03 8000

Result はこうなります。

C001 佐藤商事 O001 2024/01/01 10000
C001 佐藤商事 O002 2024/01/05 15000
C002 鈴木工業 O003 2024/01/03 8000

顧客を軸にした売上分析や、顧客別の明細レポートを作るときの“土台”として、そのまま使える形です。

応用：親1行に「横にまとめる」1対多JOIN

横展開の考え方

「顧客ごとに、直近3件の注文だけ横に並べたい」
「案件ごとに、担当者1〜3を横に並べたい」

こういうときは、親1行に対して「子の一部を横に展開」します。

Result（例）

CustomerID
CustomerName
Order1_Date
Order1_Amount
Order2_Date
Order2_Amount
Order3_Date
Order3_Amount

コード例：最大3件まで横に展開する

Public Sub Join_OneToMany_Horizontal_Max3()
    Dim wsC As Worksheet, wsR As Worksheet
    Set wsC = ThisWorkbook.Worksheets("Customers")
    
    On Error Resume Next
    Set wsR = ThisWorkbook.Worksheets("Result_H")
    On Error GoTo 0
    If wsR Is Nothing Then
        Set wsR = ThisWorkbook.Worksheets.Add
        wsR.Name = "Result_H"
    Else
        wsR.Cells.Clear
    End If
    
    wsR.Range("A1:H1").Value = Array( _
        "CustomerID", "CustomerName", _
        "Order1_Date", "Order1_Amount", _
        "Order2_Date", "Order2_Amount", _
        "Order3_Date", "Order3_Amount")
    
    Dim dictOrders As Object
    Set dictOrders = LoadOrdersByCustomer()
    
    Dim lastRowC As Long
    lastRowC = wsC.Cells(wsC.Rows.Count, 1).End(xlUp).Row
    
    Dim rC As Long, outRow As Long
    outRow = 2
    
    Dim custID As String, custName As String
    Dim col As Collection
    Dim i As Long
    Dim o As OrderRow
    
    For rC = 2 To lastRowC
        custID = CStr(wsC.Cells(rC, 1).Value)
        custName = CStr(wsC.Cells(rC, 2).Value)
        
        wsR.Cells(outRow, 1).Value = custID
        wsR.Cells(outRow, 2).Value = custName
        
        If custID <> "" And dictOrders.Exists(custID) Then
            Set col = dictOrders(custID)
            For i = 1 To Application.WorksheetFunction.Min(3, col.Count)
                o = col(i)
                wsR.Cells(outRow, 2 + (i - 1) * 2 + 1).Value = o.OrderDate
                wsR.Cells(outRow, 2 + (i - 1) * 2 + 2).Value = o.Amount
            Next
        End If
        
        outRow = outRow + 1
    Next
    
    wsR.Columns.AutoFit
    MsgBox "1対多JOIN（横展開・最大3件）が完了しました。", vbInformation
End Sub
VB

ここでの重要ポイントは、

子が何件あっても、「最大3件まで」と決めて横に並べる。
列位置を「2 + (i – 1) * 2 + 1」のように計算して、Order1/2/3の列を決めている。

このパターンは、「担当者1〜3」「電話番号1〜3」など、
“最大件数が決まっている1対多”でよく使います。

重要ポイントの深掘り：拡張JOIN（1対多）を“実務で使える部品”にするコツ

子の順序をどうするか（ソートの問題）

1対多JOINでは、「どの順番で子を並べるか」が重要です。

注文なら、日付の昇順・降順。
担当者なら、役割順（主担当→副担当）。

今回のテンプレでは、Orders シートの行順のまま Collection に入れています。
必要なら、事前に Orders をソートしておくか、
Collection ではなく配列＋ソートで順序を制御する、という発展形もあります。

子が多すぎる場合の扱い

ある顧客に対して子が100件ある、というケースも普通にあります。
縦展開なら問題ありませんが、横展開では「列が足りない」問題が出ます。

その場合は、

横展開は「直近3件だけ」にする。
それ以上は「件数だけ」を別列に持つ（例：OrderCount）。
詳細は別シート（縦展開結果）で見る。

というように、「どこまでを横に持つか」を業務として決めておく必要があります。

親に子が1件もない場合をどう扱うか

親に子がない場合、

縦展開では「親だけ1行出す」のか「出さない」のか。
横展開では「空欄のまま出す」のか。

ここも運用ルール次第です。

今回の縦展開テンプレでは、「親だけ1行出す」ようにしています。
「子がある親だけ欲しい」なら、その部分を削ればOKです。

まとめ：拡張JOIN（1対多）は「Dictionaryの値にCollectionをぶら下げる」だけで一気に世界が広がる

1対多JOINの本質は、とてもシンプルです。

子テーブルを「キー → 子行のCollection」としてDictionaryに載せる。
親を1行ずつ見ながら、そのキーにぶら下がっている子を
　縦に展開するか
　横に一部だけ並べるか
を決めて出力する。

この“型”さえ作っておけば、

顧客 → 注文
案件 → 担当者
商品 → 価格履歴
社員 → 資格一覧

など、あらゆる1対多の関係を、Excelの中で自在に扱えるようになります。

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