住所データを整理するときに「都道府県＋市区町村」と「番地以降」を分けたい場面があります。
例えば「東京都江東区亀戸1-1-1」から 「亀戸1-1-1」 を取り出すような処理です。
コード例
Sub ExtractStreetAddress()
Dim i As Long, lastRow As Long
Dim addr As String, street As String
' 都道府県リスト（47都道府県）
Dim prefectures As Variant
prefectures = Array("北海道", "青森県", "岩手県", "宮城県", "秋田県", "山形県", "福島県", _
"茨城県", "栃木県", "群馬県", "埼玉県", "千葉県", "東京都", "神奈川県", _
"新潟県", "富山県", "石川県", "福井県", "山梨県", "長野県", _
"岐阜県", "静岡県", "愛知県", "三重県", _
"滋賀県", "京都府", "大阪府", "兵庫県", "奈良県", "和歌山県", _
"鳥取県", "島根県", "岡山県", "広島県", "山口県", _
"徳島県", "香川県", "愛媛県", "高知県", _
"福岡県", "佐賀県", "長崎県", "熊本県", "大分県", "宮崎県", "鹿児島県", "沖縄県")
' A列の最終行を取得
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastRow
addr = Cells(i, 1).Value
street = ""
If addr <> "" Then
Dim j As Long
For j = LBound(prefectures) To UBound(prefectures)
If InStr(addr, prefectures(j)) = 1 Then
' 都道府県を削除
street = Mid(addr, Len(prefectures(j)) + 1)
' 市区町村まで削除（「市」「区」「町」「村」まで）
Dim pos As Long
pos = InStr(street, "市")
If pos = 0 Then pos = InStr(street, "区")
If pos = 0 Then pos = InStr(street, "町")
If pos = 0 Then pos = InStr(street, "村")
If pos > 0 Then
street = Mid(street, pos + 1) ' 市区町村名の後ろから番地以降を取得
Else
street = "不明"
End If
Exit For
End If
Next j
End If
' B列に抽出結果を出力
Cells(i, 2).Value = street
Next i
End Sub
解説
- 都道府県リスト → 住所の先頭から判定
Mid(addr, Len(prefecture)+1)→ 都道府県を削除InStr(..., "市" / "区" / "町" / "村")→ 市区町村の終わりを探すMid(street, pos+1)→ 市区町村の後ろから番地以降を抽出
実行イメージ
| A列（住所） | B列（番地以降） |
|---|---|
| 東京都江東区亀戸1-1-1 | 亀戸1-1-1 |
| 神奈川県横浜市中区山下町1-1 | 山下町1-1 |
| 大阪府大阪市北区梅田1-1-1 | 梅田1-1-1 |
| 福岡県福岡市博多区博多駅前1-1 | 博多駅前1-1 |
応用ポイント
- 郵便番号と組み合わせ → 郵便番号から住所を補完し、番地以降を抽出
- 正規表現を使う → 「丁目」「番地」「号」など細かい区切りにも対応可能
- 別シートに保存 → 元データを残しつつ、番地以降だけを管理
💡 この処理を応用すれば「番地以降を別カラムに分けてデータベース化」でき、配送や顧客管理が効率化します。
