Excel VBA 逆引き集 | マスタ系重複チェック

Excel VBA
スポンサーリンク

マスタ系重複チェック

「顧客マスタ」「商品マスタ」などの“マスタ系”は、一度重複が混ざると後工程が崩れます。だからこそ、現場で確実に効く“ユニーク制約の代替”と“入力時の予防”をセットで用意しておくのが鉄板。初心者でも貼って動くテンプレを、丁寧にかみ砕いて紹介します。

マスタ重複チェックの設計方針

  • キーを明確化: 何をユニークにするか（例：商品コード、顧客ID、メールアドレス、コード×枝番）。
  • 正規化して判定: 前後空白・大小文字・全角半角・日付書式の揺れを吸収。
  • 2段構え: 入力時にブロック（Worksheet_Change）＋定期バッチ検査（辞書＋配列）で後追いもカバー。
  • 安全運用: 元表は壊さず一覧出力→承認→“下から削除”の流れに。

共通ユーティリティ（速度・正規化・見出し検索）

Option Explicit

'高速化ON/OFF
Private Sub SpeedOn()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
End Sub
Private Sub SpeedOff()
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

'テキスト正規化（空白・大小・全半角）
Public Function NormText(ByVal v As Variant) As String
    Dim s As String: s = Trim$(CStr(v))
    s = StrConv(s, vbNarrow) '全角→半角（英数記号）
    NormText = UCase$(s)     '大文字化
End Function

'日付を文字列に統一（yyyy-mm-dd）
Public Function NormDateText(ByVal v As Variant) As String
    On Error Resume Next
    If IsDate(v) Then
        NormDateText = Format$(CDate(v), "yyyy-mm-dd")
    Else
        NormDateText = UCase$(Trim$(CStr(v)))
    End If
    On Error GoTo 0
End Function

'見出し行から列番号を取得（列順に強い）
Private Function FindHeader(ByVal headerRow As Range, ByVal name As String) As Long
    Dim hit As Range
    Set hit = headerRow.Find(What:=name, LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=False)
    FindHeader = IIf(hit Is Nothing, 0, hit.Column)
End Function

'出力シートを用意
Private Function EnsureSheet(ByVal name As String, Optional ByVal clear As Boolean = True) As Worksheet
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = Worksheets(name)
    On Error GoTo 0
    If ws Is Nothing Then
        Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
        ws.Name = name
    End If
    If clear Then ws.Cells.Clear
    Set EnsureSheet = ws
End Function
VB
  • ポイント: マスタは表記揺れが命取り。正規化を必ず通す。列順が変わっても壊れないよう見出し名で列特定。

単一キーの重複チェック（商品コード・顧客IDなど）

「Master」シートの“コード”見出し列をユニークに保てているか、重複一覧を作ります。

Sub MasterCheck_UniqueSingleKey()
    SpeedOn

    Dim ws As Worksheet: Set ws = Worksheets("Master")
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion
    Dim v As Variant: v = rg.Value

    Dim cKey As Long: cKey = FindHeader(rg.Rows(1), "コード")
    If cKey = 0 Then SpeedOff: MsgBox "見出し 'コード' がありません": Exit Sub

    Dim seen As Object: Set seen = CreateObject("Scripting.Dictionary")
    Dim pos As Object: Set pos = CreateObject("Scripting.Dictionary")

    Dim r As Long, k As String
    For r = 2 To UBound(v, 1)
        k = NormText(v(r, cKey))
        If Len(k) = 0 Then GoTo cont
        If seen.Exists(k) Then
            pos(k) = pos(k) & "," & (rg.Row + r - 1)
        Else
            seen(k) = True
            pos(k) = CStr(rg.Row + r - 1)
        End If
cont:
    Next

    Dim out As Worksheet: Set out = EnsureSheet("重複一覧_単一キー", True)
    out.Range("A1:C1").Value = Array("コード", "出現回数", "行番号一覧")

    Dim i As Long: i = 2
    Dim key As Variant, arr() As String
    For Each key In pos.Keys
        arr = Split(pos(key), ",")
        If UBound(arr) >= 1 Then
            out.Cells(i, 1).Value = key
            out.Cells(i, 2).Value = UBound(arr) + 1
            out.Cells(i, 3).Value = pos(key)
            i = i + 1
        End If
    Next

    out.Columns.AutoFit
    SpeedOff
    MsgBox "単一キーの重複チェック完了。重複キー数: " & i - 2
End Sub
VB
  • 現場の使い方: 一覧を確認→承認後に削除候補を適用（下から削除）。

複合キーの重複チェック（コード×枝番／顧客×住所など）

「コード×枝番」をユニーク制約にしたいときの候補一覧出力。

Sub MasterCheck_UniqueComposite()
    SpeedOn

    Dim ws As Worksheet: Set ws = Worksheets("Master")
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion
    Dim v As Variant: v = rg.Value

    Dim cCode As Long: cCode = FindHeader(rg.Rows(1), "コード")
    Dim cBranch As Long: cBranch = FindHeader(rg.Rows(1), "枝番")
    If cCode = 0 Or cBranch = 0 Then SpeedOff: MsgBox "見出し 'コード' または '枝番' がありません": Exit Sub

    Dim seen As Object: Set seen = CreateObject("Scripting.Dictionary")
    Dim pos As Object: Set pos = CreateObject("Scripting.Dictionary")

    Dim r As Long, key As String
    For r = 2 To UBound(v, 1)
        key = NormText(v(r, cCode)) & "|" & NormText(v(r, cBranch))
        If InStr(key, "|") = 0 Then GoTo cont
        If seen.Exists(key) Then
            pos(key) = pos(key) & "," & (rg.Row + r - 1)
        Else
            seen(key) = True
            pos(key) = CStr(rg.Row + r - 1)
        End If
cont:
    Next

    Dim out As Worksheet: Set out = EnsureSheet("重複一覧_複合キー", True)
    out.Range("A1:D1").Value = Array("コード", "枝番", "出現回数", "行番号一覧")

    Dim i As Long: i = 2
    Dim k As Variant, parts() As String, arrPos() As String
    For Each k In pos.Keys
        arrPos = Split(pos(k), ",")
        If UBound(arrPos) >= 1 Then
            parts = Split(CStr(k), "|")
            out.Cells(i, 1).Value = parts(0)
            out.Cells(i, 2).Value = parts(1)
            out.Cells(i, 3).Value = UBound(arrPos) + 1
            out.Cells(i, 4).Value = pos(k)
            i = i + 1
        End If
    Next

    out.Columns.AutoFit
    SpeedOff
    MsgBox "複合キーの重複チェック完了。重複組数: " & i - 2
End Sub
VB
  • コツ: 区切りは「|」。値内で使われにくく安全。

入力時の重複予防（シートイベントでブロック）

マスタへの新規入力時に重複を即座に検出・警告。例：「コード」列に同一がある場合に赤塗り＆元に戻す。

'監視したいマスタシートのコードモジュール（例：Masterシート）に貼る
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo fin
    If Target.Columns.Count > 1 Then Exit Sub

    ' 見出しから対象列を特定
    Dim cKeyCol As Long
    cKeyCol = Me.Rows(1).Find(What:="コード", LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=False).Column
    If cKeyCol = 0 Then Exit Sub
    If Target.Column <> cKeyCol Then Exit Sub

    Application.EnableEvents = False

    Dim cell As Range, k As String
    For Each cell In Target.Cells
        k = NormText(cell.Value)
        If Len(k) = 0 Then GoTo cont
        Dim lastRow As Long: lastRow = Me.Cells(Me.Rows.Count, cKeyCol).End(xlUp).Row
        Dim rng As Range: Set rng = Me.Range(Me.Cells(2, cKeyCol), Me.Cells(lastRow, cKeyCol))
        ' CountIfは表記揺れに弱いので「正規化」を活かすため小技：一時列に正規化値を作る版が堅い
        ' ここでは簡易に通常のCountIfでチェック（入力時の粗検知）
        If WorksheetFunction.CountIf(rng, cell.Value) > 1 Then
            cell.Interior.Color = vbRed
            MsgBox "重複コードを検知しました: " & cell.Value
            ' 任意：元に戻す（コメントアウトで通知のみ）
            'cell.Value = ""
        Else
            cell.Interior.ColorIndex = xlNone
        End If
cont:
    Next

fin:
    Application.EnableEvents = True
End Sub
VB
  • 実務の工夫: 正規化した値で厳密判定したい場合、隣列に“正規化コード列”を持ち、その列をCountIf対象にすると精度が上がります。

定期バッチで“ユニーク制約擬似検査”＋レポート

夜間や週次で、マスタ全体のユニーク性を一括検査。複数のキーを同時チェックして1枚のレポートにまとめます。

Sub MasterBatch_UniqueReport()
    SpeedOn

    Dim ws As Worksheet: Set ws = Worksheets("Master")
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion
    Dim v As Variant: v = rg.Value

    Dim colCode As Long: colCode = FindHeader(rg.Rows(1), "コード")
    Dim colName As Long: colName = FindHeader(rg.Rows(1), "名称")
    Dim colMail As Long: colMail = FindHeader(rg.Rows(1), "メール")
    If colCode = 0 Then SpeedOff: MsgBox "見出し 'コード' がありません": Exit Sub

    ' 各キーの辞書（出現→行番号蓄積）
    Dim seenCode As Object: Set seenCode = CreateObject("Scripting.Dictionary")
    Dim posCode As Object: Set posCode = CreateObject("Scripting.Dictionary")
    Dim seenMail As Object: Set seenMail = CreateObject("Scripting.Dictionary")
    Dim posMail As Object: Set posMail = CreateObject("Scripting.Dictionary")

    Dim r As Long, k As String
    For r = 2 To UBound(v, 1)
        ' コード
        k = NormText(v(r, colCode))
        If Len(k) > 0 Then
            If seenCode.Exists(k) Then posCode(k) = posCode(k) & "," & (rg.Row + r - 1) _
            Else seenCode(k) = True: posCode(k) = CStr(rg.Row + r - 1)
        End If
        ' メール（あればチェック）
        If colMail > 0 Then
            k = NormText(v(r, colMail))
            If Len(k) > 0 Then
                If seenMail.Exists(k) Then posMail(k) = posMail(k) & "," & (rg.Row + r - 1) _
                Else seenMail(k) = True: posMail(k) = CStr(rg.Row + r - 1)
            End If
        End If
    Next

    Dim out As Worksheet: Set out = EnsureSheet("マスタ重複レポート", True)
    out.Range("A1:D1").Value = Array("キー種別", "キー値", "出現回数", "行番号一覧")

    Dim i As Long: i = 2
    Dim key As Variant, arr() As String

    ' コード重複
    For Each key In posCode.Keys
        arr = Split(posCode(key), ",")
        If UBound(arr) >= 1 Then
            out.Cells(i, 1).Value = "コード"
            out.Cells(i, 2).Value = key
            out.Cells(i, 3).Value = UBound(arr) + 1
            out.Cells(i, 4).Value = posCode(key)
            i = i + 1
        End If
    Next

    ' メール重複
    For Each key In posMail.Keys
        arr = Split(posMail(key), ",")
        If UBound(arr) >= 1 Then
            out.Cells(i, 1).Value = "メール"
            out.Cells(i, 2).Value = key
            out.Cells(i, 3).Value = UBound(arr) + 1
            out.Cells(i, 4).Value = posMail(key)
            i = i + 1
        End If
    Next

    out.Columns.AutoFit
    SpeedOff
    MsgBox "マスタ重複レポートを作成しました。重複キー総数: " & i - 2
End Sub
VB
  • ポイント: 同一レポートに“コード・メール”など複数キーの重複を並べると、監査や承認が早い。

重複候補の安全削除（承認後・下から）

一覧レポートの行番号を使って、承認済みの重複候補を削除します。

Sub MasterDelete_FromReport()
    SpeedOn

    Dim wsData As Worksheet: Set wsData = Worksheets("Master")
    Dim wsRep As Worksheet: Set wsRep = Worksheets("マスタ重複レポート")
    Dim lastRow As Long: lastRow = wsRep.Cells(wsRep.Rows.Count, "D").End(xlUp).Row
    If lastRow < 2 Then SpeedOff: MsgBox "レポートが空です": Exit Sub

    ' 行番号一覧のうち、2件目以降だけ削除候補にする（先頭は残す）
    Dim dels As Collection: Set dels = New Collection
    Dim r As Long, s As String, parts() As String, i As Long
    For r = 2 To lastRow
        s = CStr(wsRep.Cells(r, "D").Value)
        If Len(s) > 0 Then
            parts = Split(s, ",")
            For i = LBound(parts) + 1 To UBound(parts)
                dels.Add CLng(parts(i))
            Next
        End If
    Next

    ' 下から削除
    Dim x As Long
    For x = dels.Count To 1 Step -1
        wsData.Rows(dels(x)).Delete
    Next

    SpeedOff
    MsgBox "重複候補を削除しました（" & dels.Count & "行、先頭は残す）"
End Sub
VB
  • 鉄則: 上から削除は行ズレの原因。必ず“下から”。

実務向け拡張：別マスタとの重複・衝突（マージ前検査）

「商品マスタ（Master_Product）のコードが、統合予定の別マスタ（Master_Product_New）にも存在する」など、マージ前に衝突を検査。

Sub MasterConflict_BetweenSheets()
    SpeedOn

    Dim wsA As Worksheet: Set wsA = Worksheets("Master_Product")
    Dim wsB As Worksheet: Set wsB = Worksheets("Master_Product_New")
    Dim rgA As Range: Set rgA = wsA.Range("A1").CurrentRegion
    Dim rgB As Range: Set rgB = wsB.Range("A1").CurrentRegion

    Dim cCodeA As Long: cCodeA = FindHeader(rgA.Rows(1), "コード")
    Dim cCodeB As Long: cCodeB = FindHeader(rgB.Rows(1), "コード")
    If cCodeA = 0 Or cCodeB = 0 Then SpeedOff: MsgBox "見出し 'コード' がありません": Exit Sub

    Dim vA As Variant: vA = rgA.Value
    Dim vB As Variant: vB = rgB.Value

    ' B側のコードを辞書化
    Dim dictB As Object: Set dictB = CreateObject("Scripting.Dictionary")
    Dim i As Long, k As String
    For i = 2 To UBound(vB, 1)
        k = NormText(vB(i, cCodeB))
        If Len(k) > 0 Then dictB(k) = True
    Next

    ' A側で衝突を抽出
    Dim out As Worksheet: Set out = EnsureSheet("マージ衝突一覧", True)
    out.Range("A1:B1").Value = Array("コード（衝突）", "A側行番号")

    Dim r As Long, o As Long: o = 2
    For r = 2 To UBound(vA, 1)
        k = NormText(vA(r, cCodeA))
        If Len(k) > 0 And dictB.Exists(k) Then
            out.Cells(o, 1).Value = k
            out.Cells(o, 2).Value = rgA.Row + r - 1
            o = o + 1
        End If
    Next

    out.Columns.AutoFit
    SpeedOff
    MsgBox "マージ前のコード衝突を検出しました。件数: " & o - 2
End Sub
VB
  • 使いどころ: マスタ統合前の“衝突”目視リスト。重複の源泉を先に消せます。

例題で練習

'例1：単一キー（コード）の重複一覧
Sub Example_UniqueSingle()
    MasterCheck_UniqueSingleKey
End Sub

'例2：複合キー（コード×枝番）の重複一覧
Sub Example_UniqueComposite()
    MasterCheck_UniqueComposite
End Sub

'例3：入力時の重複予防（コード列で即警告）
' → マスタシートのコードモジュールにWorksheet_Changeを貼る

'例4：定期バッチレポート（コード・メールの重複）
Sub Example_BatchReport()
    MasterBatch_UniqueReport
End Sub

'例5：承認後に重複候補を“下から”削除
Sub Example_DeleteFromReport()
    MasterDelete_FromReport
End Sub

'例6：別マスタとの統合前衝突検査
Sub Example_ConflictCheck()
    MasterConflict_BetweenSheets
End Sub
VB

よくある落とし穴と対策

  • 表記揺れで別物扱い: 正規化（空白・大小・全半角）を必ず通す。必要ならハイフン・記号の統一も。
  • 日付の混在で複合キーがズレる: 比較はDate型化、格納は文字列（yyyy-mm-dd）に統一。
  • 列順・見出し変更: 列番号のハードコード禁止。FindHeaderで見出しから特定。
  • いきなり削除の事故: 候補一覧→承認→“下から削除”の2段階運用。バックアップも習慣化。
  • 大量データで遅い: Range→配列化＋Dictionary（今回のテンプレの骨子）。画面・イベント・計算の停止もセット。
スポンサーリンク
タイトルとURLをコピーしました