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

<スポンサーリンク>

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

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


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

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

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

<スポンサーリンク>
目次

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

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

②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」を選択し「実行」をクリックしてください

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

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

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

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

<スポンサーリンク>
シェア頂けると嬉しいです!よろしくお願いします!
  • URLをコピーしました!

コメント

コメント一覧 (4件)

  • 先日コードをコピペして使わせていただきました。
    ありがとうございます。
    アパートやマンションも分けたいのですが、その場合コードはどのように作って、どこに挿入したら良いでしょうか?
    宜しければ教えて頂く事は可能でしょうか?
    よろしくお願い致します。

  • 「アパートやマンションも分けたい」とのことですが、少々困難かと思われます。
    この記事のコードは市町村や郡に「市・町・村」の文字が入っている場合を想定して作っているため、「市・町・村」の文字が入る郡市町村を全て網羅しています。
    「市・町・村」の文字が入る郡市町村は数十種類程度ですし、政府の発表しているデータを基にすれば判定する条件が分かるのですが、市町村の後に続く町名や番地を全て網羅することは困難です。
    例えば、日本の住所の終わりが全て数字で終わる等の条件が有ればできなくもないのですが、住所の終わりが「~号」・新しい区画で「~区画0番」・京都の「~通リ下ル」など市町村の後に続く住所は多岐に渡ります。
    判定基準がハッキリしている住所でしたら条件を追加して作ることはできるのですが、私のスキルでは現状不可能との回答になってしまいます。
    お力になれず申し訳ありません。

目次