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

Excel VBA
スポンサーリンク

ねらい：マスタの「差分抽出→安全同期」を一括で回し、常に最新状態を保つ

マスタ差分×同期は「旧マスタ」と「新マスタ」を比較して、追加・削除・変更を正しく見極め、旧マスタを最新に更新する定型業務です。配列I/O＋Dictionary＋正規化＋ハッシュ比較の型にすれば、10万行規模でも一瞬で正確に回せます。まずは“丸ごと置換”で安全運用、慣れてきたら“差分反映”に拡張しましょう。

共通基盤：配列I/O・キー正規化・列指定・行ハッシュ

一括読み書きとユーティリティ

' ModSync_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 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

Public Function RowHash(ByVal a As Variant, ByVal r As Long, ByVal idx() As Long) As String
    Dim i As Long, s As String
    For i = LBound(idx) To UBound(idx)
        s = s & NormKey(a(r, idx(i))) & "|" ' 正規化＋区切りで比較を安定化
    Next
    RowHash = s  ' 実務ではSHA-256へ差し替え可
End Function
VB

重要ポイントの深掘り

  • 正規化の徹底: 両側（旧・新）で Trim＋LCase を適用し、表記揺らぎによる誤判定をなくします。
  • 比較列の文字指定: “B,D,F” のように列を文字で選べる設計にし、列追加・入替に強くします。
  • 行ハッシュの粒度: 比較に本質的な列だけを使う（更新日時・備考などのノイズは除外）。

差分抽出：追加・削除・変更の一発判定

単一キーの差分抽出（貼って動く）

' ModSync_Diff.bas
Option Explicit

' oldSheet: 旧マスタ（A=キー）
' newSheet: 新マスタ（A=キー）
' compareColsCsv: 比較列（例 "B,C,D"）
' outStart: 出力先（例 "Z1"）
Public Sub ExtractDiff(ByVal oldSheet As String, ByVal newSheet As String, ByVal compareColsCsv As String, ByVal outStart As String)
    Dim o As Variant: o = ReadRegion(Worksheets(oldSheet))
    Dim n As Variant: n = ReadRegion(Worksheets(newSheet))
    Dim cmpIdx() As Long: cmpIdx = ColsToIndex(compareColsCsv)

    Dim dOld As Object: Set dOld = CreateObject("Scripting.Dictionary"): dOld.CompareMode = 1
    Dim hOld As Object: Set hOld = CreateObject("Scripting.Dictionary"): hOld.CompareMode = 1

    Dim r As Long
    For r = 2 To UBound(o, 1)
        Dim k As String: k = NormKey(o(r, 1))
        dOld(k) = r
        hOld(k) = RowHash(o, r, cmpIdx)
    Next

    Dim out() As Variant: ReDim out(1 To 1, 1 To 4)
    out(1, 1) = "Type": out(1, 2) = "Key": out(1, 3) = "OldHash": out(1, 4) = "NewHash"
    Dim rowsOut As Long: rowsOut = 1

    Dim seen As Object: Set seen = CreateObject("Scripting.Dictionary"): seen.CompareMode = 1
    For r = 2 To UBound(n, 1)
        Dim k As String: k = NormKey(n(r, 1))
        Dim hn As String: hn = RowHash(n, r, cmpIdx)
        seen(k) = True
        If Not dOld.Exists(k) Then
            rowsOut = rowsOut + 1: ReDim Preserve out(1 To rowsOut, 1 To 4)
            out(rowsOut, 1) = "ADDED": out(rowsOut, 2) = k: out(rowsOut, 4) = hn
        ElseIf hOld(k) <> hn Then
            rowsOut = rowsOut + 1: ReDim Preserve out(1 To rowsOut, 1 To 4)
            out(rowsOut, 1) = "CHANGED": out(rowsOut, 2) = k: out(rowsOut, 3) = hOld(k): out(rowsOut, 4) = hn
        End If
    Next

    Dim k As Variant
    For Each k In dOld.Keys
        If Not seen.Exists(k) Then
            rowsOut = rowsOut + 1: ReDim Preserve out(1 To rowsOut, 1 To 4)
            out(rowsOut, 1) = "DELETED": out(rowsOut, 2) = k: out(rowsOut, 3) = hOld(k)
        End If
    Next

    WriteBlock Worksheets(oldSheet), out, outStart
End Sub
VB

重要ポイントの深掘り

  • 3分類の即時判定: ADDED/DELETED/CHANGED を1本で抽出し、レビュー負担を大幅に減らします。
  • ハッシュ比較の狙い: 列ごとの微細差ではなく、実質的な変更にフォーカス。比較列設計が品質を左右します。

同期のやり方：丸ごと置換（安全）と差分反映（柔軟）

丸ごと置換テンプレ（最も安全でシンプル）

' ModSync_Replace.bas
Option Explicit

' 旧マスタを新マスタで完全置換
Public Sub SyncByReplace(ByVal oldSheet As String, ByVal newSheet As String)
    Dim n As Variant: n = ReadRegion(Worksheets(newSheet))
    Worksheets(oldSheet).Cells.Clear
    Worksheets(oldSheet).Range("A1").Resize(UBound(n, 1), UBound(n, 2)).Value = n
End Sub
VB

重要ポイントの深掘り

  • 事故防止: 差分反映よりも圧倒的に安全。まずはこれで運用安定化し、監査は差分一覧で担保。
  • 履歴保全: 置換前に旧マスタをCSVへ自動バックアップしておくと、即時リストア可能。

差分反映テンプレ（追加・削除・変更のみ更新）

' ModSync_ApplyDiff.bas
Option Explicit

' 比較列のみ更新、追加・削除も反映（順序維持が不要な前提）
Public Sub SyncByApplyDiff(ByVal oldSheet As String, ByVal newSheet As String, ByVal compareColsCsv As String, _
                           Optional ByVal deleteModeClear As Boolean = True)
    Dim o As Variant: o = ReadRegion(Worksheets(oldSheet))
    Dim n As Variant: n = ReadRegion(Worksheets(newSheet))
    Dim cmpIdx() As Long: cmpIdx = ColsToIndex(compareColsCsv)

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

    ' 旧→変更/削除
    For r = 2 To UBound(o, 1)
        Dim k As String: k = NormKey(o(r, 1))
        If dNew.Exists(k) Then
            Dim rr As Long: rr = dNew(k)
            Dim i As Long
            For i = LBound(cmpIdx) To UBound(cmpIdx)
                If CStr(o(r, cmpIdx(i))) <> CStr(n(rr, cmpIdx(i))) Then
                    o(r, cmpIdx(i)) = n(rr, cmpIdx(i))
                End If
            Next
        Else
            If deleteModeClear Then
                Dim c As Long: For c = 1 To UBound(o, 2): o(r, c) = "": Next ' 監査用の空白化
            Else
                ' 実削除は行再構築が必要（要件に応じて実装）
            End If
        End If
    Next

    ' 追加（旧にないキーを末尾へ）
    Dim rowsOut As Long: rowsOut = UBound(o, 1)
    Dim k As Variant
    For Each k In dNew.Keys
        Dim found As Boolean: found = False
        For r = 2 To UBound(o, 1)
            If NormKey(o(r, 1)) = k Then found = True: Exit For
        Next
        If Not found Then
            rowsOut = rowsOut + 1: ReDim Preserve o(1 To rowsOut, 1 To UBound(n, 2))
            Dim rr As Long: rr = dNew(k)
            Dim c As Long: For c = 1 To UBound(n, 2): o(rowsOut, c) = n(rr, c): Next
        End If
    Next

    WriteBlock Worksheets(oldSheet), o, "A1"
End Sub
VB

重要ポイントの深掘り

  • 削除の扱い: 監査重視なら空白化、軽量化重視なら実削除。現場ポリシーを先に決めます。
  • 追加の順序: 末尾追加が基本。順序が重要なら最後に安定ソートを入れると良いです。
  • 比較列設計: 更新日時などノイズ列は外し、業務的に意味のある列だけを反映対象に。

一括テンプレ：差分抽出→詳細確認→同期のパイプライン（例題）

パイプライン実行例（商品マスタ）

' ModSync_Example.bas
Option Explicit

Public Sub Run_MasterDiffSync()
    ' 1) 差分抽出（B,C列を比較）
    ExtractDiff "Master_Old", "Master_New", "B,C", "Z1"
    ' 2) 同期（安全運用なら丸ごと置換）
    SyncByReplace "Master_Old", "Master_New"
    ' 3) 柔軟運用へ：差分反映に切り替える場合
    ' SyncByApplyDiff "Master_Old", "Master_New", "B,C", True
    MsgBox "マスタ差分×同期の一括処理が完了しました。", vbInformation
End Sub
VB

重要ポイントの深掘り

  • 出口の固定: 差分一覧の出力開始セル（Z1など）を固定し、レビュー導線を明確にします。
  • 段階的導入: まずは置換で安定運用→要件が固まったら差分反映へ移行。

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

正規化不足による誤差分

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

比較列にノイズが混在

  • 対策: 業務に効く列だけ比較。更新日時、備考、担当者などは差分から外す。

削除ポリシーの曖昧さ

  • 対策: 監査要件に応じて“空白化/実削除”を明示。コード引数で切替できるようにしておく。

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

  • 対策: 必ず配列で結果を作り、一括書き戻し。UIが固まらず、桁違いに高速。

まとめ：差分抽出＋（置換 or 差分反映）を型にして、強い同期運用へ

  • 差分抽出で「何が変わったか」を明示し、まずは丸ごと置換で安全に最新化。
  • 仕様が固まったら差分反映に切り替え、追加・削除・変更だけを更新。
  • 正規化・比較列設計・一括書き戻しの三点セットで、規模が大きくても壊れません。

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