Excel VBA | Cells を使った「住所から市区町村を抽出する」応用例

Sub ExtractCityWardTown()
    Dim i As Long, lastRow As Long
    Dim addr As String, city 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
        city = ""
        
        If addr <> "" Then
            Dim j As Long
            For j = LBound(prefectures) To UBound(prefectures)
                If InStr(addr, prefectures(j)) = 1 Then
                    ' 都道府県名を削除して残りを取得
                    city = Mid(addr, Len(prefectures(j)) + 1)
                    
                    ' 市区町村部分を抽出（「市」「区」「町」「村」まで）
                    Dim pos As Long
                    pos = InStr(city, "市")
                    If pos = 0 Then pos = InStr(city, "区")
                    If pos = 0 Then pos = InStr(city, "町")
                    If pos = 0 Then pos = InStr(city, "村")
                    
                    If pos > 0 Then
                        city = Left(city, pos)
                    Else
                        city = "不明"
                    End If
                    
                    Exit For
                End If
            Next j
        End If
        
        ' B列に抽出結果を出力
        Cells(i, 2).Value = city
    Next i
End Sub

Sub ExtractCityWardTown()
    Dim i As Long, lastRow As Long
    Dim addr As String, city 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
        city = ""
        
        If addr <> "" Then
            Dim j As Long
            For j = LBound(prefectures) To UBound(prefectures)
                If InStr(addr, prefectures(j)) = 1 Then
                    ' 都道府県名を削除して残りを取得
                    city = Mid(addr, Len(prefectures(j)) + 1)
                    
                    ' 市区町村部分を抽出（「市」「区」「町」「村」まで）
                    Dim pos As Long
                    pos = InStr(city, "市")
                    If pos = 0 Then pos = InStr(city, "区")
                    If pos = 0 Then pos = InStr(city, "町")
                    If pos = 0 Then pos = InStr(city, "村")
                    
                    If pos > 0 Then
                        city = Left(city, pos)
                    Else
                        city = "不明"
                    End If
                    
                    Exit For
                End If
            Next j
        End If
        
        ' B列に抽出結果を出力
        Cells(i, 2).Value = city
    Next i
End Sub