Excel VBA 逆引き集 | 実務テンプレ完全版（超再利用部品） – 名寄せ高速ツール

Excel VBA
スポンサーリンク

ねらい：ぐちゃぐちゃな「同じ顧客」を、機械的に“同一人物グループ”にまとめる

名寄せは、「同じ人・同じ会社なのに、表記ゆれや入力ゆれでバラバラに登録されているレコードをまとめる」作業です。
顧客マスタ、取引先マスタ、問い合わせ履歴、どこにでも出てきます。

株式会社エー・ビー・シー
(株)ABC
ＡＢＣ株式会社

これを人の目と勘でやると、時間もかかるし、見落としも出ます。
ここで目指す「名寄せ高速ツール」は、次のような流れをテンプレ化することです。

元データを「名寄せ用のキー」に変換する（正規化）。
そのキーを使って、同じグループに属する行を機械的にまとめる。
結果を「グループID付きの一覧」や「代表レコード＋紐づくレコード一覧」として出せるようにする。

完全な“あいまい一致エンジン”ではなく、「Excel VBA で現実的に回せる名寄せの型」を作るイメージです。

設計の考え方：名寄せは「キー作り」と「グルーピング」に分ける

名寄せの本質は「比較前の正規化」

名寄せで一番大事なのは、「比較の前にどこまで揃えるか」です。
いきなり「文字列同士を似ているかどうか」で比べ始めると、処理も重いし、ロジックも複雑になります。

まずは、次のような“正規化”を考えます。

全角・半角を統一する。
ひらがな・カタカナを統一する。
大文字・小文字を統一する。
株式会社、(株)、（株）などの表記を統一する。
スペースや記号を取り除く。

この「正規化後の文字列」を名寄せキーとして使い、
完全一致でグルーピングするだけでも、かなりの名寄せが自動化できます。

ここでは、まず「正規化＋完全一致」で名寄せする高速テンプレを作り、
そのあと「少しだけあいまい度を上げる」ための工夫も触れます。

正規化ユーティリティ：名寄せキーを作るための関数群

全角・半角、ひらがな・カタカナ、大文字・小文字の統一

まずは、文字種を揃えるための関数を用意します。
VBA 標準の StrConv を使うと、ある程度は簡単にできます。

' ModNayose_Normalize.bas
Option Explicit

Public Function NormalizeTextBasic(ByVal s As String) As String
    Dim t As String
    t = s
    
    t = StrConv(t, vbNarrow)
    t = StrConv(t, vbKatakana)
    t = UCase$(t)
    
    t = Replace(t, "　", " ")
    t = Trim$(t)
    
    NormalizeTextBasic = t
End Function
VB

ここでやっていることは、次の通りです。

全角を半角にする（vbNarrow）。
ひらがなをカタカナにする（vbKatakana）。
アルファベットを大文字にする。
全角スペースを半角スペースにし、前後のスペースを削る。

これだけでも、「ＡＢＣ」「abc」「Ａｂｃ」は全部同じ文字列になります。

会社名向けの正規化（株式会社・(株)・（株）など）

会社名の名寄せでは、「株式会社」の表記ゆれをどう扱うかが重要です。
よくあるパターンを、機械的に置換してしまいます。

Public Function NormalizeCompanyName(ByVal s As String) As String
    Dim t As String
    t = NormalizeTextBasic(s)
    
    t = Replace(t, "（株）", "株式会社")
    t = Replace(t, "(株)", "株式会社")
    t = Replace(t, "㈱", "株式会社")
    
    t = Replace(t, "（有）", "有限会社")
    t = Replace(t, "(有)", "有限会社")
    t = Replace(t, "㈲", "有限会社")
    
    t = Replace(t, "　", " ")
    t = Replace(t, " ", "")
    
    NormalizeCompanyName = t
End Function
VB

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

NormalizeTextBasic で「文字種」を揃えたあとに、株式会社・有限会社の表記ゆれを統一しています。
最後にスペースを全部消しています。会社名の名寄せでは、スペースの有無はあまり意味がないことが多いからです。

例えば、

“株式会社 エー・ビー・シー”
“(株)エー ビー シー”

は、どちらも "株式会社エービーシー" のようなキーに変換されます。

名寄せキーを作るラッパー関数

会社名以外にも、個人名や住所など、正規化のルールは変わります。
ここでは例として「会社名用の名寄せキー」を作る関数を用意します。

Public Function MakeNayoseKey_Company(ByVal rawName As String) As String
    MakeNayoseKey_Company = NormalizeCompanyName(rawName)
End Function
VB

実務では、「個人名用」「住所用」など、用途ごとに関数を分けておくと管理しやすくなります。

名寄せ高速ツール本体：名寄せキーでグルーピングする

基本方針：名寄せキー → グループID

名寄せの実行部分では、次のような流れを取ります。

元データの「会社名」列から、名寄せキーを作る。
名寄せキーごとにグループIDを振る（1,2,3,…）。
元データに「名寄せキー」と「グループID」を書き戻す。

これを VBA で書くと、次のようになります。

' ModNayose_Core.bas
Option Explicit

Public Sub RunNayose_Company(ByVal ws As Worksheet, _
                             ByVal nameCol As Long, _
                             ByVal headerRow As Long, _
                             ByVal keyCol As Long, _
                             ByVal groupCol As Long)
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, nameCol).End(xlUp).Row
    If lastRow <= headerRow Then
        MsgBox "データ行がありません。", vbInformation
        Exit Sub
    End If
    
    Dim v As Variant
    v = ws.Range(ws.Cells(headerRow + 1, nameCol), ws.Cells(lastRow, nameCol)).Value
    
    Dim keys() As String
    ReDim keys(1 To UBound(v, 1))
    
    Dim i As Long
    For i = 1 To UBound(v, 1)
        keys(i) = MakeNayoseKey_Company(CStr(v(i, 1)))
    Next
    
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = 1
    
    Dim groupId As Long
    groupId = 0
    
    Dim key As String
    Dim g As Long
    Dim groupArr() As Variant
    ReDim groupArr(1 To UBound(v, 1), 1 To 1)
    
    For i = 1 To UBound(keys)
        key = keys(i)
        If key = "" Then
            g = 0
        Else
            If dict.Exists(key) Then
                g = dict(key)
            Else
                groupId = groupId + 1
                dict.Add key, groupId
                g = groupId
            End If
        End If
        groupArr(i, 1) = g
    Next
    
    ws.Range(ws.Cells(headerRow + 1, keyCol), ws.Cells(lastRow, keyCol)).Value = WorksheetFunction.Transpose(keys)
    ws.Range(ws.Cells(headerRow + 1, groupCol), ws.Cells(lastRow, groupCol)).Value = groupArr
    
    ws.Cells(headerRow, keyCol).Value = "名寄せキー"
    ws.Cells(headerRow, groupCol).Value = "名寄せグループID"
    
    MsgBox "名寄せキーとグループIDの付与が完了しました。", vbInformation
End Sub
VB

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

元データの会社名列を配列に読み込んでから処理しているので、高速です（セルを1つずつ触らない）。
名寄せキーごとに Dictionary でグループIDを管理しています。
同じキーが出てきたら同じグループID、新しいキーなら新しいグループIDを振ります。
名寄せキーとグループIDを、元シートの指定列に一括で書き戻しています。

グループIDが同じ行は、「機械的に見て同じ会社と判断されたグループ」です。
あとはこのグループIDを使って、代表レコードを選んだり、統合処理をしたりできます。

例題：顧客マスタの会社名を名寄せして、グループごとに並べる

顧客マスタの前提

シート名を「Customer」とし、次のような構造を想定します。

A列：顧客ID
B列：会社名
C列：住所
D列：電話番号

1行目がヘッダです。
名寄せキーを E列、グループID を F列に出したいとします。

実行用ラッパー Sub

Public Sub RunNayose_Company_Customer()
    Dim ws As Worksheet
    Set ws = Worksheets("Customer")
    
    Call RunNayose_Company(ws, 2, 1, 5, 6)
    
    ws.Range("A1").CurrentRegion.Sort Key1:=ws.Range("F1"), Order1:=xlAscending, Header:=xlYes
End Sub
VB

この Sub を実行すると、次のことが起こります。

B列の会社名から名寄せキーが作られ、E列に書き込まれる。
名寄せキーごとにグループIDが振られ、F列に書き込まれる。
最後に、グループID（F列）で全体がソートされる。

結果として、「同じグループIDの行がまとまって並ぶ」状態になります。
画面上で見ると、「同じ会社と判断されたレコード」が縦に固まって見えるので、
人間が最終確認するのもかなり楽になります。

もう一歩だけ踏み込む：電話番号や郵便番号もキーに混ぜる

会社名だけだと不安なときの「複合名寄せキー」

会社名だけで名寄せすると、「同じ名前の別会社」も同じグループに入ってしまう可能性があります。
そこで、電話番号や郵便番号など、もう1つ情報を混ぜて「複合名寄せキー」にすることもよくあります。

例えば、

名寄せキー = 正規化会社名 ＋ “|” ＋ 正規化電話番号

のようにします。

電話番号の正規化は、数字だけを抜き出すのが定番です。

Public Function NormalizeTel(ByVal s As String) As String
    Dim t As String
    t = s
    
    t = StrConv(t, vbNarrow)
    
    Dim i As Long
    Dim ch As String
    Dim out As String
    out = ""
    
    For i = 1 To Len(t)
        ch = Mid$(t, i, 1)
        If ch >= "0" And ch <= "9" Then
            out = out & ch
        End If
    Next
    
    NormalizeTel = out
End Function
VB

これを使って、複合名寄せキーを作る関数を書きます。

Public Function MakeNayoseKey_CompanyTel(ByVal rawName As String, ByVal rawTel As String) As String
    Dim nameKey As String
    Dim telKey As String
    
    nameKey = NormalizeCompanyName(rawName)
    telKey = NormalizeTel(rawTel)
    
    MakeNayoseKey_CompanyTel = nameKey & "|" & telKey
End Function
VB

あとは、RunNayose_Company の中で MakeNayoseKey_Company を呼んでいた部分を、
MakeNayoseKey_CompanyTel に差し替え、電話番号列も引数で渡すようにすれば、
「会社名＋電話番号」で名寄せする版になります。

ここでの深掘りポイントは、「名寄せキーの設計は業務ルールそのもの」ということです。
どの情報をどこまで使うかで、「どこまで同一とみなすか」が変わります。
VBA はあくまでそのルールを機械的に実行するだけです。

落とし穴と対策：名寄せは“自動で完璧”を目指さない

名寄せは「候補を絞るツール」であって、「最終判断者」ではない

どれだけ正規化を頑張っても、「完全に正しい名寄せ」を自動でやるのは難しいです。
同じ会社なのに別グループになってしまうこともあれば、別会社なのに同じグループに入ってしまうこともあります。

大事なのは、「名寄せツールの役割」をこう定義することです。

人間が目で確認すべき候補を、できるだけ少ないグループに絞り込む。
明らかに同じものは自動でまとめるが、グレーなものは人が判断する前提で残す。

そのために、

名寄せキーとグループIDを付けて「候補グループ」を作る。
グループごとに代表レコードを選ぶためのビュー（ピボットや別シート）を用意する。
最終的な統合は、人が見ながら行う。

という運用をセットで考えるのが現実的です。

正規化が強すぎると「別物まで同じ」に見えてしまう

NormalizeCompanyName でスペースを全部消したり、「株式会社」を全部同じにしたりすると、
「似ているけど別物」も同じキーになってしまうことがあります。

例えば、「株式会社東京」と「株式会社東京商事」は、
雑にスペースを消すと似たキーになりがちです。

このバランスは、現場のデータを見ながら調整するしかありません。

スペースは残すか、一部だけ消すか。
「株式会社」は消してしまうか、残すか。
電話番号や住所もキーに混ぜるか。

名寄せツールを作るときは、最初から完璧を狙わず、
「まずは会社名だけ」「次に電話番号も足す」と段階的に精度を上げていくのが良いです。

行数が多いときのパフォーマンス

名寄せは「全行を一度は見る」処理なので、行数が多いとそれなりに時間がかかります。
ただし、配列＋Dictionary で書いておけば、数万行程度なら十分実用的な速度で動きます。

さらに速くしたいときは、

ScreenUpdating を False にする。
計算モードを手動にしておく。
名寄せ対象の列だけを別シートに抜き出してから処理する。

といった工夫で、体感速度をかなり改善できます。

まとめ：名寄せも「正規化関数」と「グルーピング関数」に分解してテンプレ化する

名寄せ高速ツールの本質は、次の二段構えです。

正規化関数で、「名寄せキー」を作る。
名寄せキーごとにグループIDを振るグルーピング処理を走らせる。

NormalizeTextBasic / NormalizeCompanyName / NormalizeTel などで、
「業務ルールに沿った正規化」を関数として固定する。

RunNayose_Company のような汎用グルーピング Sub で、
どのシートにも同じロジックをコピペで持ち込めるようにする。

ここまで型を作っておけば、あとは

会社名だけで名寄せするか
会社名＋電話番号で名寄せするか
個人名＋住所で名寄せするか

といった「キーの設計」を変えるだけで、
いろいろな名寄せパターンを高速に回せるようになります。

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