Excelの住所録から建物名を抽出する方法

Question

実現したいこと

スペースで区切られていない住所から建物名だけを抽出したい
例:
東京都○区○○1-1-1ABCビル111→ABCビル
東京都○区○○1-1-1カタカナハイツ111→カタカナハイツ
東京都○区○○1-1-1漢字荘111→漢字荘

前提

住所録をexcelで管理しています
データは１住所１セルごとにスペースやカンマ区切りなく入っています

表記は統一されておらず
”東京都○区○○1-1-1”
”東京都○区○○1丁目1-1"
”東京都○区○○一丁目1-1”
のパターンがあります

また建物名に関しても
建物名がはいっていないもの　”東京都○区○○1-1-1-111”
建物名と部屋番号①　”東京都○区○○1-1-1建物名111”　　
建物名と部屋番号②　”東京都○区○○1-1-1建物名111号室”
など同一の建物でも複数の表記があります

建物名は漢字,カタカナ,アルファベット表記があります

試したこと

建物名を抽出する方法が分からなかったため、
まず関数で丁目以降の部分を抽出できないか試しました。

=MID(A1, MATCH(TRUE, ISNUMBER(1*MID(A1, ROW($1:$1000), 1)), 0)+1, LEN(A1))

見よう見まねでVBAでも試しました。

Sub ExtractData ()
    Dim rng As Range
    Dim cell As Range
    Dim address As String
    Dim buildingName As String
    Dim i As Integer

    Set rng = ThisWorkbook.Sheets("report (1)").Range("$BC1:BC" & ThisWorkbook.Sheets("report (1)").Cells(Rows.Count, 1).End(xlUp).Row)

    For Each cell In rng
        address = cell.Value
        i = InStrRev(address, "丁目")
        
        
        buildingName = Mid(address, i + 2)
        
        cell.Offset(0, 1).Value = buildingName
    Next cell
End Sub

ただどちらにしても表記ブレがあるせいで"1-1-1"と"1-1"の２パターン生じてしまいます。

次に”-”以降を抽出する方法

Sub ExtractData()
    Dim rng As Range
    Dim cell As Range
    Set rng = ThisWorkbook.Sheets("report (1)").Range("BC:BC")
    
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 1).Value = Mid(cell.Value, InStrRev(cell.Value, "-") + 1)
        End If
    Next cell
End Sub

こちらでは”-”のあと○号の部分の数字とそれ以降の建物名と部屋番号部分が抽出できました。
ただこちらも数字が一桁の場合と２桁の場合があり、抽出後のデータから建物名以降を抜き出す方法が分かりません。

最後にchatgptに頼んで出力してもらったのがこちら

Sub ExtractData()
    Dim rng As Range
    Dim cell As Range
    Set rng = ThisWorkbook.Sheets("Sheet1").Range("A:A")
    
    For Each cell In rng
        If cell.Value <> "" Then
            Dim str As String
            str = cell.Value
            Dim firstNumber As Integer
            Dim secondNumber As Integer
            Dim i As Integer
            firstNumber = 0
            secondNumber = 0
            For i = 1 To Len(str)
                If IsNumeric(Mid(str, i, 1)) Then
                    If firstNumber = 0 Then
                        firstNumber = i
                    Else
                        secondNumber = i
                        Exit For
                    End If
                End If
            Next i
            If firstNumber > 0 And secondNumber > 0 Then
                cell.Offset(0, 1).Value = Mid(str, firstNumber + 1, secondNumber - firstNumber - 1)
            Else
                cell.Offset(0, 1).Value = "N/A"
            End If
        End If
    Next cell
End Sub

こちらだとそもそも抽出できませんでした（1丁目1のような表記になっているものは”丁目”が抽出されました）。

補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。
Microsoft　office365

Comments

[hoshi-takanori]

> 建物名は漢字,カタカナ,アルファベット表記があります
第2○○ビルのように数字を含む場合もありそう…。

住所の正規化の記事は色々ありますが、建物名を抽出するならこれとか参考になるかも？
https://qiita.com/YSRKEN/items/5371e67950425ace6a73

Answer 1

提示された例をみると、以下の方法でとりだすことができそうです。
数字と数字の間に挟まれた数字以外で構成される文字列。
上記の文字列が取り出せれば、建物名となります。

Sub ExtractData()
    Dim rng As Range
    Dim cell As Range
    Dim address As String
    Dim buildingName As String
    Dim i As Integer

    Set rng = ThisWorkbook.Sheets("report (1)").Range("$BC1:BC" & ThisWorkbook.Sheets("report (1)").Cells(Rows.Count, 1).End(xlUp).Row)

    For Each cell In rng
        address = cell.Value
        Call Tatemonomei(address, buildingName)
        
        cell.Offset(0, 1).Value = buildingName
    Next cell
End Sub

Public Sub Tatemonomei(ByVal addr As String, ByRef building)
    Dim RE As Object
    Dim rematch As Object
    building = ""
    Set RE = CreateObject("VBScript.RegExp")
    RE.Pattern = "([0-9０-９])([^0-9０-９]+)([0-9０-９])*(号|号室)?$"
    RE.Global = True
    Set rematch = RE.Execute(addr)
    If rematch.Count < 1 Then Exit Sub
    building = rematch(0).submatches(1)
End Sub

全て、上記のパターン通りならこれで問題ないはずですが、例外がある場合は、その都度対応が必要かと思います。
このマクロでは
東京都○区○○1丁目漢字荘123　は　"丁目漢字荘" を抽出します。
東京都○区○○1丁目1漢字荘123号室　は　"号室" を抽出します。
提示されたケース以外に例外があるようでしたら、追記してください。
対応可能であれば、対応します。