ねらい：SQLのJOINを「配列I/O＋Dictionary」で爆速・堅牢に再現する
Excelでシート関数や手作業の結合は遅く、列変更に弱く、壊れやすい。VBAなら「片側を辞書化→配列で一括結合→一括書き戻し」という型で、INNER/LEFT/FULL OUTER、複合キー、重複（多対一/一対多）まで安定・高速に処理できます。初心者でも貼って動くテンプレを、実務で迷いやすい“欠損・重複・ヘッダ・列変更耐性”を深掘りしながら解説します。
基盤：配列I/O・キー正規化・列指定の共通部品
配列I/Oとキー正規化
' ModJoin_Base.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 MakeKey2(ByVal v1 As Variant, ByVal v2 As Variant) As String
MakeKey2 = NormKey(v1) & SEP & NormKey(v2)
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
重要ポイントの深掘り
- 正規化は“辞書登録時・参照時の両方”で同じ関数を通すのが鉄則。片側だけではヒット漏れが起こります。
- 逐次セル操作は速度低下のもと。必ず配列に作って“一括”で書き戻します。
- 複合キーは“ありえない文字”で束ね、誤連結（例: “ab”＋“c”と“a”＋“bc”が同じになる）を根絶します。
INNER JOIN（単一キー）：一致行のみ結合して出力
貼って動くテンプレ（右の選択列を結合）
' ModJoin_Inner_Single.bas
Option Explicit
' leftSheet: 左（A=キー、B以降=左属性）
' rightSheet: 右（A=キー、colsCsvで指定列を返す。例 "B,D"）
' outStart: 出力開始（例 "Z1"）
Public Sub InnerJoin1(ByVal leftSheet As String, ByVal rightSheet As String, ByVal outStart As String, ByVal colsCsv As String)
Dim aL As Variant: aL = ReadRegion(Worksheets(leftSheet))
Dim aR As Variant: aR = ReadRegion(Worksheets(rightSheet))
Dim retIdx() As Long: retIdx = ColsToIndex(colsCsv)
' 右：key → 返却列パック
Dim d As Object: Set d = CreateObject("Scripting.Dictionary"): d.CompareMode = 1
Dim r As Long, c As Long
For r = 2 To UBound(aR, 1)
Dim k As String: k = NormKey(aR(r, 1))
Dim pack() As Variant: ReDim pack(1 To UBound(retIdx) + 1)
For c = 0 To UBound(retIdx)
pack(c + 1) = aR(r, retIdx(c))
Next
d(k) = pack
Next
' ヘッダ（左のキー除外＋右ヘッダ）
Dim outCols As Long: outCols = (UBound(aL, 2) - 1) + (UBound(retIdx) + 1)
Dim out() As Variant: ReDim out(1 To 1, 1 To outCols)
Dim w As Long: w = 0
Dim cL As Long
For cL = 2 To UBound(aL, 2)
w = w + 1: out(1, w) = aL(1, cL)
Next
For c = 0 To UBound(retIdx)
w = w + 1: out(1, w) = Worksheets(rightSheet).Cells(1, retIdx(c)).Value
Next
' データ（両側に存在するキーのみ）
Dim rowsOut As Long: rowsOut = 1
For r = 2 To UBound(aL, 1)
Dim key As String: key = NormKey(aL(r, 1))
If d.Exists(key) Then
rowsOut = rowsOut + 1: ReDim Preserve out(1 To rowsOut, 1 To outCols)
w = 0
For cL = 2 To UBound(aL, 2)
w = w + 1: out(rowsOut, w) = aL(r, cL)
Next
Dim pack2 As Variant: pack2 = d(key)
For c = 1 To UBound(pack2)
w = w + 1: out(rowsOut, w) = pack2(c)
Next
End If
Next
WriteBlock Worksheets(leftSheet), out, outStart
End Sub
重要ポイントの深掘り
- ヘッダ1行目は固定扱い。データは2行目から。これだけで事故が激減します。
- 返却列を“文字指定”で外出し（”B,D,F”）すれば、列追加・入れ替えに強くなります。
LEFT JOIN（単一キー）：左基準で欠損は空埋め
欠損は仕様通り（空/0/N/A）に統一
' ModJoin_Left_Single.bas
Option Explicit
Public Sub LeftJoin1(ByVal leftSheet As String, ByVal rightSheet As String, ByVal outStart As String, ByVal colsCsv As String, Optional ByVal missingVal As Variant = "")
Dim aL As Variant: aL = ReadRegion(Worksheets(leftSheet))
Dim aR As Variant: aR = ReadRegion(Worksheets(rightSheet))
Dim retIdx() As Long: retIdx = ColsToIndex(colsCsv)
' 右：key → 行番号（列増減に強い）
Dim dR As Object: Set dR = CreateObject("Scripting.Dictionary"): dR.CompareMode = 1
Dim r As Long: For r = 2 To UBound(aR, 1): dR(NormKey(aR(r, 1))) = r: Next
Dim outCols As Long: outCols = (UBound(aL, 2) - 1) + (UBound(retIdx) + 1)
Dim out() As Variant: ReDim out(1 To UBound(aL, 1), 1 To outCols)
' ヘッダ
Dim w As Long: w = 0: Dim cL As Long
For cL = 2 To UBound(aL, 2)
w = w + 1: out(1, w) = aL(1, cL)
Next
Dim c As Long
For c = 0 To UBound(retIdx)
w = w + 1: out(1, w) = Worksheets(rightSheet).Cells(1, retIdx(c)).Value
Next
' データ（左は必ず出す）
For r = 2 To UBound(aL, 1)
w = 0
For cL = 2 To UBound(aL, 2)
w = w + 1: out(r, w) = aL(r, cL)
Next
Dim key As String: key = NormKey(aL(r, 1))
If dR.Exists(key) Then
Dim rr As Long: rr = dR(key)
For c = 0 To UBound(retIdx)
w = w + 1: out(r, w) = aR(rr, retIdx(c))
Next
Else
For c = 0 To UBound(retIdx)
w = w + 1: out(r, w) = missingVal
Next
End If
Next
WriteBlock Worksheets(leftSheet), out, outStart
End Sub
重要ポイントの深掘り
- 欠損値は最初に仕様決め（空/0/N/A）。ピボットや集計の下流で崩さない値に統一します。
- 右は“行番号辞書”方式にすると、返却列の増減に柔軟に追随できます。
FULL OUTER／セミ／アンチJOIN：監査・差分・品質チェック向け
FULL OUTER：MATCH/LEFT_ONLY/RIGHT_ONLYを明示
' ModJoin_FullOuter.bas
Option Explicit
Public Sub FullOuterJoin1(ByVal leftSheet As String, ByVal rightSheet As String, ByVal outStart As String)
Dim aL As Variant: aL = ReadRegion(Worksheets(leftSheet))
Dim aR As Variant: aR = ReadRegion(Worksheets(rightSheet))
Dim dR As Object: Set dR = CreateObject("Scripting.Dictionary"): dR.CompareMode = 1
Dim seen As Object: Set seen = CreateObject("Scripting.Dictionary"): seen.CompareMode = 1
Dim r As Long: For r = 2 To UBound(aR, 1): dR(NormKey(aR(r, 1))) = r: Next
Dim outCols As Long: outCols = 2 + (UBound(aL, 2) - 1) + (UBound(aR, 2) - 1)
Dim out() As Variant: ReDim out(1 To 1, 1 To outCols)
out(1, 1) = "Type": out(1, 2) = "Key"
Dim w As Long: w = 2, c As Long
For c = 2 To UBound(aL, 2): w = w + 1: out(1, w) = "L_" & aL(1, c): Next
For c = 2 To UBound(aR, 2): w = w + 1: out(1, w) = "R_" & aR(1, c): Next
Dim rowsOut As Long: rowsOut = 1
' 左側出力
For r = 2 To UBound(aL, 1)
Dim key As String: key = NormKey(aL(r, 1))
rowsOut = rowsOut + 1: ReDim Preserve out(1 To rowsOut, 1 To outCols)
w = 2: out(rowsOut, 2) = key
For c = 2 To UBound(aL, 2): w = w + 1: out(rowsOut, w) = aL(r, c): Next
If dR.Exists(key) Then
out(rowsOut, 1) = "MATCH": seen(key) = True
Dim rr As Long: rr = dR(key)
For c = 2 To UBound(aR, 2): w = w + 1: out(rowsOut, w) = aR(rr, c): Next
Else
out(rowsOut, 1) = "LEFT_ONLY"
For c = 2 To UBound(aR, 2): w = w + 1: out(rowsOut, w) = "": Next
End If
Next
' 右のみ
Dim k As Variant
For Each k In dR.Keys
If Not seen.Exists(k) Then
rowsOut = rowsOut + 1: ReDim Preserve out(1 To rowsOut, 1 To outCols)
out(rowsOut, 1) = "RIGHT_ONLY": out(rowsOut, 2) = k
w = 2
For c = 2 To UBound(aL, 2): w = w + 1: out(rowsOut, w) = "": Next
Dim rr2 As Long: rr2 = dR(k)
For c = 2 To UBound(aR, 2): w = w + 1: out(rowsOut, w) = aR(rr2, c): Next
End If
Next
WriteBlock Worksheets(leftSheet), out, outStart
End Sub
セミJOIN（存在フラグ）／アンチJOIN（未登録抽出）
' セミJOIN：右に存在するか（Y/N）だけ付与
Public Sub SemiJoinFlag(ByVal leftSheet As String, ByVal rightSheet As String, ByVal outCol As String)
Dim aL As Variant: aL = ReadRegion(Worksheets(leftSheet))
Dim aR As Variant: aR = ReadRegion(Worksheets(rightSheet))
Dim dR As Object: Set dR = CreateObject("Scripting.Dictionary"): dR.CompareMode = 1
Dim r As Long: For r = 2 To UBound(aR, 1): dR(NormKey(aR(r, 1))) = True: Next
Dim out() As Variant: ReDim out(1 To UBound(aL, 1), 1 To 1)
out(1, 1) = "Exists"
For r = 2 To UBound(aL, 1)
out(r, 1) = IIf(dR.Exists(NormKey(aL(r, 1))), "Y", "N")
Next
WriteBlock Worksheets(leftSheet), out, outCol & "1"
End Sub
' アンチJOIN：右にない左の行だけ抽出
Public Sub AntiJoinExtract(ByVal leftSheet As String, ByVal rightSheet As String, ByVal outStart As String)
Dim aL As Variant: aL = ReadRegion(Worksheets(leftSheet))
Dim aR As Variant: aR = ReadRegion(Worksheets(rightSheet))
Dim dR As Object: Set dR = CreateObject("Scripting.Dictionary"): dR.CompareMode = 1
Dim r As Long: For r = 2 To UBound(aR, 1): dR(NormKey(aR(r, 1))) = True: Next
Dim out() As Variant: ReDim out(1 To 1, 1 To UBound(aL, 2))
Dim c As Long: For c = 1 To UBound(aL, 2): out(1, c) = aL(1, c): Next
Dim rowsOut As Long: rowsOut = 1
For r = 2 To UBound(aL, 1)
If Not dR.Exists(NormKey(aL(r, 1))) Then
rowsOut = rowsOut + 1: ReDim Preserve out(1 To rowsOut, 1 To UBound(aL, 2))
For c = 1 To UBound(aL, 2): out(rowsOut, c) = aL(r, c): Next
End If
Next
WriteBlock Worksheets(leftSheet), out, outStart
End Sub
重要ポイントの深掘り
- 監査にはFULL OUTERが効く。Type列で“どちらだけ”かを明示すると差分が一目で分かります。
- セミ/アンチJOINは品質の定番チェック（存在フラグ・未登録抽出）。毎日のデータ健全性確認に最適。
重複キーの扱い：最初/最後/全件展開を選べるように
最後の一致を採用（上書き方式）
' ModJoin_LastHit.bas
Option Explicit
Public Sub LeftJoinLastHit(ByVal leftSheet As String, ByVal rightSheet As String, ByVal outCol As String)
Dim aL As Variant: aL = ReadRegion(Worksheets(leftSheet))
Dim aR As Variant: aR = ReadRegion(Worksheets(rightSheet))
Dim d As Object: Set d = CreateObject("Scripting.Dictionary"): d.CompareMode = 1
Dim r As Long: For r = 2 To UBound(aR, 1): d(NormKey(aR(r, 1))) = aR(r, 2): Next
Dim out() As Variant: ReDim out(1 To UBound(aL, 1), 1 To 1): out(1, 1) = "Attr"
For r = 2 To UBound(aL, 1)
Dim k As String: k = NormKey(aL(r, 1))
out(r, 1) = IIf(d.Exists(k), d(k), "")
Next
WriteBlock Worksheets(leftSheet), out, outCol & "1"
End Sub
全件展開（多対多の縦増幅・監査用）
' ModJoin_ExpandAll.bas
Option Explicit
Public Sub InnerJoinExpandAll(ByVal leftSheet As String, ByVal rightSheet As String, ByVal outStart As String)
Dim aL As Variant: aL = ReadRegion(Worksheets(leftSheet))
Dim aR As Variant: aR = ReadRegion(Worksheets(rightSheet))
' 右：key → 行番号のCollection
Dim idx As Object: Set idx = CreateObject("Scripting.Dictionary"): idx.CompareMode = 1
Dim r As Long
For r = 2 To UBound(aR, 1)
Dim k As String: k = NormKey(aR(r, 1))
If Not idx.Exists(k) Then
Dim col As Collection: Set col = New Collection
col.Add r: Set idx(k) = col
Else
idx(k).Add r
End If
Next
' ヘッダ（左全列＋右キー除いた全列）
Dim outCols As Long: outCols = UBound(aL, 2) + (UBound(aR, 2) - 1)
Dim out() As Variant: ReDim out(1 To 1, 1 To outCols)
Dim c As Long, w As Long: w = 0
For c = 1 To UBound(aL, 2): w = w + 1: out(1, w) = "L_" & aL(1, c): Next
For c = 2 To UBound(aR, 2): w = w + 1: out(1, w) = "R_" & aR(1, c): Next
Dim rowsOut As Long: rowsOut = 1
For r = 2 To UBound(aL, 1)
Dim key As String: key = NormKey(aL(r, 1))
If idx.Exists(key) Then
Dim col As Collection: Set col = idx(key)
Dim i As Long
For i = 1 To col.Count
rowsOut = rowsOut + 1: ReDim Preserve out(1 To rowsOut, 1 To outCols)
w = 0
For c = 1 To UBound(aL, 2): w = w + 1: out(rowsOut, w) = aL(r, c): Next
Dim rr As Long: rr = col(i)
For c = 2 To UBound(aR, 2): w = w + 1: out(rowsOut, w) = aR(rr, c): Next
Next
End If
Next
WriteBlock Worksheets(leftSheet), out, outStart
End Sub
重要ポイントの深掘り
- 実務では重複が珍しくない。採用方針（最初/最後/全件展開/集約）を“最初に仕様化”し、コードで明示します。
- 全件展開は行数が増えるので“監査用”に割り切り、本処理は方針（例：最後採用）で省コストに。
例題：顧客明細＋顧客マスタの結合を一撃で
LEFT JOINで顧客名・カテゴリを付与
' ModJoin_Example.bas
Option Explicit
Public Sub Demo_LeftJoinCustomer()
' Detail: A=顧客ID, B=日付, C=金額
' Master: A=顧客ID, B=顧客名, D=カテゴリ（Cは他用途）
LeftJoin1 "Detail", "Master", "Z1", "B,D", "" ' 欠損は空
MsgBox "顧客名・カテゴリの結合が完了しました（LEFT JOIN）。", vbInformation
End Sub
INNER JOINで一致行のみ抽出
Public Sub Demo_InnerJoinMatched()
InnerJoin1 "Detail", "Master", "AA1", "B,D"
MsgBox "一致行のみの結合が完了しました（INNER JOIN）。", vbInformation
End Sub
落とし穴と対策（深掘り）
ヒット漏れ（正規化不足）
- 対策: NormKey（Trim/LCase）を登録・参照の両側に必ず適用。必要なら全半角統一の前処理も。
列追加でコードが壊れる
- 対策: 返却列は文字指定（”B,D,F”）＋右は行番号辞書。ヘッダは1行目固定で扱い、変更に強く。
セル逐次書きで遅い・固まる
- 対策: 結果は配列で作成し、最後に一括書き戻し。これだけで速度が桁違いに向上。
重複キーの扱いが曖昧
- 対策: “最後採用/最初採用/全件展開/集約”を仕様に明記。辞書値にCollectionを使って表現。
まとめ：JOINは「辞書化＋配列結合＋正規化」で“速く・壊れない”部品になる
- INNER/LEFT/FULL OUTER、セミ/アンチJOINをテンプレ化し、欠損・重複・列変更に強い。
- 複合キーは安全な区切りで束ね、返却は配列パックで柔軟に。
- 配列I/O＋辞書＋正規化の“三点セット”を守れば、ExcelでもSQL級のJOINを実務速度で安定運用できます。