住所のセル分割について VBA

質問

マクロについてお尋ねします。

A1のセル
●●市山田町１－１山田ハウス１１１号
のように町名と番地（全角数字）とアパート・マンション名が続けて入っているセルがいくつもあります。
これを
B1→　●●市山田町
C1→　１－１山田ハウス１１１号
※住所を前から見ていき、全角数字（１～９）が出たらC1に分割

のように２つのセルに分割したいのです。
A1のセルで全角数字（１～９）のいずれかの数字が出たら
その数字からC1に分割したいのですがどのようにすればいいのでしょうか。

町名と番地（１－１）の間にはなにもありません。
また番地までの住所の長さはまちまちです。
よろしくお願いいたします。

回答No.2

hananoppo · ベストアンサー

条件に合うように修正しました。次のマクロでどうでしょう。

Sub Macro1()
Dim AdrCell As Range
Dim Adr As String
Dim AdrLen As Integer
Dim i As Integer
Dim ChrCode As Integer

For Each AdrCell In Range(Range("A1"), Cells(Rows.Count, 1).End(xlUp))
Adr = AdrCell.Value
AdrLen = Len(Adr)
For i = 1 To AdrLen
ChrCode = Asc(Mid(Adr, i))
If &H824F < ChrCode And ChrCode < &H8259 Then
AdrCell.Offset(0, 1).Value = Left(Adr, i - 1)
AdrCell.Offset(0, 2).NumberFormatLocal = "@"
AdrCell.Offset(0, 2).Value = Right(Adr, AdrLen - i + 1)
Exit For
End If
Next i
Next
End Sub

お礼

ありがとうございました！！
理想通りの動きです！

手持ちの住所データ145件、きれいに分割することが出来ました。
早いご回答に感謝いたします。

ありがとうございました。

回答No.1

hananoppo

分割したい住所を複数選択した状態で次のマクロを実行してみてください。

Sub Macro1()
Dim AdrCell As Range
Dim Adr As String
Dim AdrLen As Integer
Dim i As Integer
Dim ChrCode As Integer

For Each AdrCell In Selection
Adr = AdrCell.Value
AdrLen = Len(Adr)
For i = 1 To AdrLen
ChrCode = Asc(Mid(Adr, i))
If &H824F < ChrCode And ChrCode < &H8259 Then
AdrCell.Offset(0, 1).Value = Left(Adr, i - 1)
AdrCell.Offset(0, 2).Value = Right(Adr, AdrLen - i + 1)
Exit For
End If
Next i
Next
End Sub

お礼

早速のご回答ありがとうございました！
A列に住所データを入れ、対象の住所データを選択した状態でマクロを実行したところ
きれいに全角数字で分割することができました。

ただ、住所が「●●市■■町２－１５－７」でアパート名が無い場合は分割した際,
B列に「●●市■■町」C列に「2007/2/15」というように日付形式になってしまいます。

もちろんアパート名が無い場合、C列全て日付形式になるのではなく
「●●市■■町４－９５－５」の場合はきれいに
B列に「●●市■■町」C列に「４－９５－５」というように入ります。

また、もう1点お尋ねしたいのですが、
A列（分割したい住所データ）を選択しない状態でマクロを実行させることはできますでしょうか。
重ね重ね、申し訳ございません。

ご教示頂ければ幸いです。
どうぞ宜しくお願い致します。