【VBA】文字列の場所入れ替え

こちらの識者の方々にはいつもお世話になっています。
VBAの質問です。

環境は下記になります。
OS=windowsXP SP3
Office=Excel2003(11.8347.8403) SP3

A列に住所のデータがあるのですが、形式がちょっと特殊で、
A1 千代田区千代田1-1-1-301千代田マンション１号棟
A2 千代田区千代田2-3-4
というな形になっています。(A1,A2はセル番地表示で、その文字列がセルにあるわけではありません)

並び順が、市名（区名）・町名・丁目・番地・号地・部屋番号・物件名となっています。
データの定義は、丁目・番地・号地・部屋番号については半角数字・市名（区名）・町名・物件名は数字やアルファベットを含むものであっても全角であることは担保されております。

戸建てであればいいのですが、集合住宅の場合、物件名と部屋番号が入れ替わってしまっています。
これを、できればA列には住所、B列には物件名・（全角スペース）・部屋番号とわけたいのです。
　　A　　　　　　　　　　　B
1　千代田区千代田1-1-1　　千代田マンション１号棟　301
2　千代田区千代田2-3-4

1.最後の文字列が全角か半角かで処理を分岐、（半角ならスルー、全角なら2.以降に）
2.セル内の最後の半角文字の次の文字から最後の文字までを抜き出す
3.最後のハイフン（-）の次の文字から全角文字の前の文字までを抜き出す
4.2と3で抜き出した文字列を合体
という流れでやろうと思い、まずは1のコードを、StrConv(Right(Range("A1"),1), vbNarrow) で検査してみたのですが、vbNarrowは半角に変換できる文字列のみ対応しているようで、漢字のものはスルーされてしまい、検査段階で既に頓挫しています。

上記のような場合、どのようなコードが適していますでしょうか。
質問に不備不足等ございましたらご指摘ください。
ご面倒お掛けしますがよろしくお願いします。

No.4 ベストアンサー 回答者： MarcoRossiItaly 回答日時： 2013/10/27 14:22

No.3 です、ああそうでしたね、失礼しました。

ですが、No.3 でお伝えした知識を再活用するだけでできます。変数「pos3」を新設、「pos2 = 0」の次に 5 行を挿入してください。こうすると、同一セルに 2 回ずつ書き込むことになります。もう 1 変数を用意してその中で完成形の文字列まで一気に作って 1 回だけセルに記入するよりも速度は劣ると思いますが、とりあえず目的の結果は得られます。


Sub SplitAddresses()
　　Dim i As Long, n As Integer, pos1 As Integer, pos2 As Integer, pos3 As Integer
　　For i = 1 To Cells(Rows.Count, "a").End(xlUp).Row
　　　　With Cells(i, "a")
　　　　　　For n = 0 To 9
　　　　　　　　pos1 = InStrRev(.Value, n)
　　　　　　　　If pos2 < pos1 Then pos2 = pos1
　　　　　　Next n
　　　　　　Cells(i, "b").Value = Right$(.Value, Len(.Value) - pos2)
　　　　　　.Value = Left$(.Value, pos2)
　　　　　　pos2 = 0
　　　　　　pos3 = InStrRev(.Value, "-")
　　　　　　If pos3 And Cells(i, "b").Value <> "" Then
　　　　　　　　Cells(i, "b").Value = Cells(i, "b").Value & "　" & Right$(.Value, Len(.Value) - pos3)
　　　　　　　　.Value = Left$(.Value, pos3 - 1)
　　　　　　End If
　　　　End With
　　Next i
　　Columns("a:b").AutoFit
End Sub

この回答へのお礼

できました！
しかもこの方法の素晴らしいところは、InStrRevで文字列の末尾から検索しているため、番地までしかない住所であっても対応できるところですね！

助かりました！本当にありがとうございます！

お礼日時：2013/10/27 15:54

No.3 回答者： MarcoRossiItaly 回答日時： 2013/10/27 10:09

「町丁の数字は半角、それ以外の数字は全角」という情報を全面的に信頼して、簡潔にコーディングしてみました。

文字列中の特定文字（列）の位置検索では、文字列の最後の文字から逆順で見ていったほうがよい場合がよくあります。その目的のために、InStrRev という組み込み関数が用意されています。注意点としては、後ろから文字を探していって始めて見付かった位置を求めるのですが、関数が返す数値は、前から数えたときの位置だということです。

ご存じとは思いますが、マクロでデータを加工すると、元に戻せません。シートをバックアップしてから実行されることをお勧めします。


Sub SplitAddresses()
　　Dim i As Long, n As Integer, pos1 As Integer, pos2 As Integer
　　For i = 1 To Cells(Rows.Count, "a").End(xlUp).Row
　　　　With Cells(i, "a")
　　　　　　For n = 0 To 9
　　　　　　　　pos1 = InStrRev(.Value, n)
　　　　　　　　If pos2 < pos1 Then pos2 = pos1
　　　　　　Next n
　　　　　　Cells(i, "b").Value = Right$(.Value, Len(.Value) - pos2)
　　　　　　.Value = Left$(.Value, pos2)
　　　　　　pos2 = 0
　　　　End With
　　Next i
　　Columns("a:b").AutoFit
End Sub

この回答への補足

ご回答ありがとうございます。
For n = 0 To 9
で最初の半角数字の位置を割り出し、そこでSplitしてA列とB列に分けているんですね。
ただ、申し訳ないのですが、B列には物件名と部屋番号まで入力したいんです。
上記コードですと、A列には住所+部屋番号、B列には物件名となってしまいました。

でも
If pos2 < pos1 Then pos2 = pos1
というコードは、なるほどなぁーと思いました。

補足日時：2013/10/27 13:39

No.2 回答者： tom04 回答日時： 2013/10/26 20:13

No.1です。

質問文をもう一度よく読み返してみると
前回は大きな勘違いをしていました。

（A列）千代田区千代田1-1-1-301千代田マンション１号棟
↓
（A列）千代田区千代田1-1-1　（B列）千代田マンション１号棟　301
のようにしなくてはならないのですね！
規則性としては「部屋番号」がある住所に関しては、ハイフンが3個入っているという判断にしています。

前回は単純に半角英数字・ハイフン以降の文字をB列に表示させているだけですので、
↓のコードに変更してください。

Sub Sample2()
Dim i As Long, k As Long, cnt As Long, str As String
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
For k = 1 To Len(Cells(i, "A"))
If Mid(Cells(i, "A"), k, 1) Like "[0-9]" Then
Exit For
End If
Next k
cnt = k
Do While Mid(Cells(i, "A"), cnt, 1) Like "[0-9,-]"
cnt = cnt + 1
Loop
str = Left(Cells(i, "A"), cnt - 1)
With Cells(i, "A")
.Offset(, 1) = Replace(Cells(i, "A"), str, "")
.Value = str
End With
If Len(Cells(i, "A")) - Len(Replace(Cells(i, "A"), "-", "")) > 2 Then
Cells(i, "A") = WorksheetFunction.Substitute(Cells(i, "A"), "-", "*", 3)
cnt = InStr(Cells(i, "A"), "*")
str = Mid(Cells(i, "A"), cnt + 1, Len(Cells(i, "A")))
Cells(i, "A") = Left(Cells(i, "A"), cnt - 1)
Cells(i, "B") = Cells(i, "B") & "　" & str
End If
Next i
Columns.AutoFit
End Sub

今度はどうでしょうか？m(_ _)m

この回答への補足

ご回答ありがとうございます。
例で提示した2つについては問題なく動作しました。
ただ、こちらの情報不足で申し訳ないのですが、住所の中には番地までしかない住所が存在するのです（データ上だけというわけではなく、実際にそういう住所が日本に存在します）
このため、ハイフンの数で判別してしまうと、番地までしかない住所で、かつ集合住宅の場合にデータがおかしくなってしまいます。
そんなに多くないので手作業で直してもいいのですが、できればマクロでこの問題を解決できるコードはありますでしょうか。

補足日時：2013/10/27 13:51

No.1 回答者： tom04 回答日時： 2013/10/26 17:46

こんにちは！

Sub Sample1()
Dim i As Long, k As Long, cnt As Long, str As String
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
For k = 1 To Len(Cells(i, "A"))
If Mid(Cells(i, "A"), k, 1) Like "[0-9]" Then
Exit For
End If
Next k
cnt = k
Do While Mid(Cells(i, "A"), cnt, 1) Like "[0-9,-]"
cnt = cnt + 1
Loop
str = Left(Cells(i, "A"), cnt - 1)
With Cells(i, "A")
.Offset(, 1) = Replace(Cells(i, "A"), str, "")
.Value = str
End With
For k = 1 To Len(Cells(i, "B"))
If Mid(StrConv(Cells(i, "B"), vbNarrow), k, 1) Like "[1-9]" Then
Exit For
End If
Next k
Cells(i, "B") = Left(Cells(i, "B"), k - 1) & "　" & Mid(Cells(i, "B"), k, Len(Cells(i, "B")))
Next i
Columns.AutoFit
End Sub

こんな感じではどうでしょうか？
※　詳しく検証していませんので
ご希望通りにならなかったらごめんなさいね。m(_ _)m