Excel VBA | 郵便番号データベースと突合して精度を上げる方法

VBA

2011.02.052025.11.02

住所分割の精度を上げるには、日本郵便が公開している「郵便番号データベース（KEN_ALL.CSV）」を突合して使うのが最も確実です。
これにより「表記ゆれ」や「町域の判定ミス」を防ぎ、正規表現だけでは難しいケースも正しく処理できます。

郵便番号データベースを使った精度向上の流れ
サンプルコード（郵便番号から住所を取得）
✅ この方法のメリット
💡 応用

郵便番号データベースを使った精度向上の流れ

郵便番号データの入手
- 日本郵便公式サイトから「全国一括版 KEN_ALL.CSV」をダウンロード
- 日本郵便郵便番号データダウンロードページ
Excelに取り込み
- CSVをExcelにインポートし、別シートに「郵便番号」「都道府県」「市区町村」「町域」を格納
- 例：シート名を ZipDB としておく
VBAで突合処理
- 入力された郵便番号をキーにして、VLOOKUP や Dictionary を使って住所を引き当てる

サンプルコード（郵便番号から住所を取得）

Sub ZipToAddress()
    Dim zip As String
    Dim result As Variant
    Dim lastRow As Long, i As Long
    
    ' 入力データはA列に郵便番号、出力はB列以降
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To lastRow
        zip = Replace(Cells(i, 1).Value, "-", "") ' ハイフン除去
        
        ' 郵便番号をキーにVLOOKUPで検索
        result = Application.VLookup(zip, Sheets("ZipDB").Range("A:D"), 2, False)
        
        If Not IsError(result) Then
            Cells(i, 2).Value = result                       ' 都道府県
            Cells(i, 3).Value = Application.VLookup(zip, Sheets("ZipDB").Range("A:D"), 3, False) ' 市区町村
            Cells(i, 4).Value = Application.VLookup(zip, Sheets("ZipDB").Range("A:D"), 4, False) ' 町域
        Else
            Cells(i, 2).Value = "未登録"
        End If
    Next i
End Sub

Sub ZipToAddress()
    Dim zip As String
    Dim result As Variant
    Dim lastRow As Long, i As Long
    
    ' 入力データはA列に郵便番号、出力はB列以降
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To lastRow
        zip = Replace(Cells(i, 1).Value, "-", "") ' ハイフン除去
        
        ' 郵便番号をキーにVLOOKUPで検索
        result = Application.VLookup(zip, Sheets("ZipDB").Range("A:D"), 2, False)
        
        If Not IsError(result) Then
            Cells(i, 2).Value = result                       ' 都道府県
            Cells(i, 3).Value = Application.VLookup(zip, Sheets("ZipDB").Range("A:D"), 3, False) ' 市区町村
            Cells(i, 4).Value = Application.VLookup(zip, Sheets("ZipDB").Range("A:D"), 4, False) ' 町域
        Else
            Cells(i, 2).Value = "未登録"
        End If
    Next i
End Sub