【VBA】全角半角入り交じった住所を分割

Book1のA列に記載されている市区町村番地を、別のファイルであるBook2のA列とB列に、それぞれ市区町村と番地に分けて転記するVBAを教えていただけますでしょうか。
住所は半角全角が入り交じっていますが、どちらかに統一するのではなく、記載されているとおりに転記したいです。
全角だけ、もしくは半角だけを抜き出すマクロは見つけたのですが、どちらであっても分割できるマクロがわかりません。

下記の住所を、、、
Book1
A列
港区赤坂１−２−３
港区赤坂1-2-3
港区赤坂1-2−３

下記のように分割して別ファイルに転記
Book2
A列　　　　B列
港区赤坂　　１−２−３
港区赤坂　　1-2-3
港区赤坂　　1-2−３

お知恵をお貸し下さい。
よろしくお願いいたします。

No.1 ベストアンサー 回答者： tom04 回答日時： 2017/01/17 22:50

こんばんは！

元データはSheet1のA2セル以降にあり、Sheet2に表示するとします。
尚、「番地」は必ず数値から始まるものとします。
標準モジュールにしてください。

Sub Sample1()
Dim i As Long, k As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Range("A:B").ClearContents
With Worksheets("Sheet1")
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
For k = 1 To Len(.Cells(i, "A"))
If Mid(StrConv(.Cells(i, "A"), vbNarrow), k, 1) Like "[0-9]" Then Exit For
Next k
If k < Len(.Cells(i, "A")) Then
wS.Cells(i, "A") = Left(.Cells(i, "A"), k - 1)
wS.Cells(i, "B").NumberFormatLocal = "@"
wS.Cells(i, "B") = Replace(.Cells(i, "A"), wS.Cells(i, "A"), "")
End If
Next i
End With
End Sub

こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

ありがとうございます！こちらで完璧にできました。
私がいろんなところから引っ張ってきたコードを組み合わせて作った長〜いマクロがあるのですが、それの仕上げで住所分割をする必要があり困ってました。
今日の午前中で一度提出だったのですが、いただいたコードをいじらせていただき何とか間に合わせることができました。
本当に感謝感激でございます。
こういうのが自分で書けるようになったら最高ですね。憧れてしまいます。
私も引き続き勉強がんばります！
本当にありがとうございました！

お礼日時：2017/01/18 12:06

No.3 回答者： tatsu99 回答日時： 2017/01/18 08:57

補足要求の続きです。

港区赤坂1-2−３ 港ビル302号
のような番地の後にビルの名前などがくるケースはありますか。

No.2 回答者： tatsu99 回答日時： 2017/01/17 23:50

補足要求です。

１)拡張子について
book1の拡張子はxlsですか、xlsxですか、xlsmですか。
book2の拡張子はxlsですか、xlsxですか、xlsmですか。
２）シート名について
book1のA列のシート名はなんですか。
book2のA,B列のシート名はなんですか。
３）番地は0~９（全角及び半角）、ハイフン”-”（全角及び半角）以外の文字はないと考えてよいですか。
間にスペース等はないと考えてよいですか。下記例参照
港区赤坂1-2　−３
４）見出し
book1,book2ともに1行目は見出しと考えてよいですか。