エクセルの住所録を都道府県、市区町村、町名以降に一括で分ける

エクセルの住所録を「都道府県」、「市区町村」、「町名以降」に一括で分割する方法をご紹介します。

下図のような住所録を一括で変換します。（下図は都道府県庁の住所一覧です）

↓

エクセル初心者でも使えるよう説明するつもりです。

なお、文字列を判定して入力していくのですが、１文字違っただけで正常に作動しない等の不具合が起こり得ますのでご注意ください
また、１つ１つのデータは、必ずご自分でチェックしてください（不具合が出る可能性が高いです）

仕様は以下になります。
■平成２８年４月に総務省が発表している市町村データを基に作成しています（令和4年6月現在、新たな市町村合併はありませんので最新版です）
（今後市町村の合併等で市区町村名が変わったり追加された場合に、不具合が出る可能性があります。）
■元住所の１列右に都道府県、２列右に市区町村、３列右に町名以降を入力します
■政令指定都市の区は元住所の２列右に市名と一緒に入力します
■都道府県が入っていない住所は処理をしません（都道府県名を含めて判定している市町村があるため）
■町田市、四日市市など、市町村名の中に「市・町・村」の文字があるものにも対応しています（たぶん大丈夫だと思います）

1．処理するエクセルファイルの準備

新しいファイルやシートを作成し、その新しいシートに住所をコピペして処理します。
※この処理を行うのは後戻りのできない（「元に戻す」が使えない）プログラム処理ですので、今使っている大元のシートでは使わないでください。
住所が入っている列の右３列に入力しますので、その３列は住所入力用として空白にしておいてください。

②VBAコードを標準モジュールに貼り付ける
「Alt」を押しながら「F11」を押してください
下のような画面が出てくると思います
赤枠で囲った部分のメニューが出ていない場合は「Ctrl」を押しながら「r」を押してください

目的のファイル名の上で右クリック
↓
「挿入」をクリック
↓
「標準モジュール」をクリック

すると右側に大きな白いスペースが現れたと思います
※↓画像の赤枠部分

このスペースに以下のコードをコピペしてください
（右下の「1クリックでコードをコピー」をクリックしてください）

Sub MYADDRESS_Split()    '平成28年4月版
    Application.ScreenUpdating = False
    On Error Resume Next
    Dim mypref, mycity, mydesignatedcity, myarea, mymetro, mycounty As Variant
    Dim c As Range
    Dim i, t, s, r, q, a, b, d, e, f, g, h, j As Integer
    mypref = Array("都", "道", "府", "県")
    mycity = Array("市", "町", "村")
    mydesignatedcity = Array("宮城県柴田郡村田町", "群馬県佐波郡玉村町", "北海道余市郡余市町", _
                            "栃木県芳賀郡市貝町", "東京都町田市", "新潟県十日町市", "富山県中新川郡上市町", _
                            "山梨県西八代郡市川三郷町", "長野県大町市", "兵庫県神崎郡市川町", _
                            "奈良県吉野郡下市町", "山形県村山市", "福島県田村市", "東京都東村山市", _
                            "東京都武蔵村山市", "東京都羽村市", "新潟県村上市", "長崎県大村市", _
                            "佐賀県杵島郡大町町", "千葉県市川市", "千葉県市原市", "石川県野々市市", _
                            "三重県四日市市", "広島県廿日市市")
    myarea = Array("札幌市", "仙台市", "さいたま市", "埼玉市", "千葉市", "横浜市", "川崎市", "相模原市", _
                    "新潟市", "静岡市", "浜松市", "名古屋市", "京都市", "大阪市", "堺市", "神戸市", _
                    "岡山市", "広島市", "北九州市", "福岡市", "熊本市")
    mymetro = Array("千代田区", "中央区", "港区", "新宿区", "文京区", "台東区", "墨田区", "江東区", "品川区", _
                    "目黒区", "大田区", "世田谷区", "渋谷区", "中野区", "杉並区", "豊島区", "北区", "荒川区", _
                    "板橋区", "練馬区", "足立区", "葛飾区", "江戸川区")
    mycounty = Array("余市郡仁木町", "余市郡赤井川村", "東村山郡山辺町", "東村山郡中山町", "西村山郡河北町", _
                    "西村山郡西川町", "西村山郡朝日町", "西村山郡大江町", "北村山郡大石田町", "田村郡三春町", _
                    "田村郡小野町", "高市郡高取町", "高市郡明日香村")
    For Each c In Selection
        s = 0
        For i = 3 To 4
            For t = 0 To 3
                If Mid(c, i, 1) = mypref(t) Then
                    c.Offset(0, 1) = Left(c, i)
                    s = s + 1
                    Exit For
                End If
            Next
            If s = 1 Then
                Exit For
            End If
            If i = 4 Then
                If s = 0 Then
                    c.Interior.Color = 16711680
                    j = j + 1
                    GoTo myend
                End If
            End If
        Next
        If mypref(t) = "都" And InStr(Left(c, 7), "区") > 0 Then
            For a = 0 To 22
                If InStr(c, mymetro(a)) > 0 Then
                    c.Offset(0, 2) = mymetro(a)
                    c.Offset(0, 3) = Mid(c, Len(c.Offset(0, 1)) + Len(c.Offset(0, 2)) + 1, Len(c))
                    GoTo myend
                End If
            Next
        End If
        For r = 0 To 20
            If InStr(c, myarea(r)) > 0 Then
                For b = 1 To Len(c)
                    If Mid(c, b, 1) = "区" Then
                        c.Offset(0, 2) = Mid(c, i + 1, b - i)
                        c.Offset(0, 3) = Mid(c, Len(c.Offset(0, 1)) + Len(c.Offset(0, 2)) + 1, Len(c))
                        GoTo myend:
                    End If
                Next
            End If
        Next
        For q = 0 To 23
            If InStr(c, mydesignatedcity(q)) > 0 Then
                c.Offset(0, 2) = Mid(c, i + 1, Len(mydesignatedcity(q)) - i)
                c.Offset(0, 3) = Mid(c, Len(c.Offset(0, 1)) + Len(c.Offset(0, 2)) + 1, Len(c))
                GoTo myend
            End If
        Next
        For g = 0 To 12
            If InStr(c, mycounty(g)) > 0 Then
                c.Offset(0, 2) = mycounty(g)
                c.Offset(0, 3) = Mid(c, Len(c.Offset(0, 1)) + Len(c.Offset(0, 2)) + 1, Len(c))
                GoTo myend
            End If
        Next
        f = 0
        For d = 1 To Len(c)
            For e = 0 To 2
                If mycity(e) = Mid(c, d, 1) Then
                    c.Offset(0, 2) = Mid(c, i + 1, d - i)
                    c.Offset(0, 3) = Mid(c, Len(c.Offset(0, 1)) + Len(c.Offset(0, 2)) + 1, Len(c))
                    f = f + 1
                    Exit For
                End If
            Next
            If f = 1 Then
                Exit For
            End If
        Next
myend:
    Next
    If j > 0 Then
        MsgBox j & "個の住所は処理できませんでした" & vbCrLf & "（青色塗りつぶしのセル）"
    End If
End Sub

③今貼り付けたプログラムを実行する
住所を選択してください。（選択しているセル分だけ処理します）

「開発タブ」の「マクロ」を選択
開発タブが表示されて無い場合は開発タブを表示する方法を参考にしてください

「MYADDRESS_Split」を選択し「実行」をクリックしてください

ここまでの手順をこなすと、下記のように住所が分割されると思います

一応なんとか分割できるように作れたと思いますが、ご自身で目視にてチェックをすることは怠らないでください。

不具合が起きる場合の一例を挙げると
■「市町村」が抜けている（住所録としてオカシイですが記入漏れなどがあり得ます）と２列目と３列目が空白になってしまいます。
■今現在は無い昔の市町村名で入力されており、「市町村名」に「市・町・村」のいずれかが入っている。
（昔：滋賀県八日市市　→　現在：滋賀県東近江市　など）
■「大阪市」が「大坂市」と間違って入力されている。（誤字脱字があると処理できないことがあります）
などなど、不具合が起きる様々な要因があります。

予期しない不具合が出ることを前提にしていただき、この記事をご活用ください。
なお、当ブログの記事を用いることによって被った損害・損失に対しては一切の責任を負いかねますのであらかじめご了承下さい。