Excel VBAで住所の切り分け

質問

氏名と住所が混ざったセルを持つ「Ａ列」があるのですが、これを
氏名部分と住所部分とでそれぞれ「Ｂ列」と「Ｃ列」に切り出したいと思っています。
「Ａ列」のセルは以下の例のように、氏名+住所となっています。

　「Ａ列」セルの例　yamada taro 1-5-2 minatoku tokyo
　　　　　　　　　 tanaka yoshio 4-5-1 toshimaku tokyo
　　　　　※英語表記のであり、「氏名」の次には必ず番地が続いています。

instr関数を使用し、ひとまずは氏名だけを「B列」に切り出すため、以下のように
マクロを作成してみたのですが、うまくいきませんでした。
複数セルに対して一括で処理したいので、範囲選択して処理するようにしています。
--------------------------------------------------
Sub マクロ１()
Dim A列
For Each A列 In Selection
A列.Offset(, 1).Value = Left([A列], InStr([A列], "1" or "2" or "3" or "4" or "5" or "6" or "7" or "8" or "9") - 1)
Next A列

End Sub
--------------------------------------------------
「A列」の値中1～9いずれかの数字が何文字目にあるかを確認し、その１文字前までの値を
左から抽出し、「A列」隣の「B列」に入力する。ということを目的に記述したのですが、
うまく切り分けられませんでした。

以下のように数字がひとつだけであれば、上記例の1-5-2のような番地で、うまく切り分けられたのですが、１～９までの数字が現れうる状況で、どのように記述すればうまく切り分けができるのでしょうか。
A列.Offset(, 1).Value = Left([A列], InStr([A列], "1" ) - 1)

非常に分かりづらい説明となってしまい申し訳ございませんが、
どなたかお教えいただけませんでしょうか。

よろしくお願いいたします。

回答No.1

SI299792 · ベストアンサー

関数でもできます。
必ずスペースがあり、２番目のスペースで分けるなら、
B2　=LEFT(A2,FIND(" ",A2,FIND(" ",A2)+1)+1)
C2　=MID(A2,FIND(" ",A2,FIND(" ",A2)+1)+1,100)

最初の数字で分けるなら
B2　=LEFT(A2,MIN(SEARCH({1,2,3,4,5,6,7,8,9,0},A2&1234567890))-2)
C2　=MID(A2,MIN(SEARCH({1,2,3,4,5,6,7,8,9,0},A2&1234567890)),100)

VBA ならこうなります。
A1にタイトルがあり、A2からデータが入っている設定です。
'
Option Explicit
'
Sub Macro1()
'
　　Dim RegExp As Object
　　Dim Row As Long
　　Dim What As String
　　Dim Execute As Object
　　Dim FirstIndex As Integer
'
　　Set RegExp = CreateObject("VBScript.RegExp")
　　RegExp.Global = True
　　RegExp.Pattern = "\d"
'
　　For Row = 2 To [A1].End(xlDown).Row
　　　　What = Cells(Row, "A")
　　　　Set Execute = RegExp.Execute(What)
　　　　FirstIndex = Execute(0).FirstIndex
　　　　Cells(Row, "B") = Left(What, FirstIndex)
　　　　Cells(Row, "C") = Mid(What, FirstIndex + 1)
　　Next Row
End Sub

お礼

ご丁寧にご回答ありがとうございました
B2　=LEFT(A2,MIN(SEARCH({1,2,3,4,5,6,7,8,9,0},A2&1234567890))-2)
C2　=MID(A2,MIN(SEARCH({1,2,3,4,5,6,7,8,9,0},A2&1234567890)),100)
の式をVBAで記述したらうまくできました。
大変勉強になりました。

回答No.2

watabe007

>For Each A列 In Selection
>　　A列.Offset(, 1).Value = Left([
Sub Test()
　　Dim A列 As Range, n As Long
　　For Each A列 In Selection
　　　　n = Evaluate("MIN(SEARCH({1,2,3,4,5,6,7,8,9,0}," & A列.Address & "&1234567890))")
　　　　A列.Offset(, 1).Value = Left(A列, n - 1)
　　　　A列.Offset(, 2).Value = Mid(A列, n)
　　Next
End Sub

お礼

ご回答ありがとうございました！
教えていただいたコードを参考に記述したら
うまくいきました。