エクセルのマクロ 【】の中だけ抽出〒と住所を分ける

質問

あるデータからコピペしてエクセルに並べ替えたいのですが

例えば
山田　太郎【やまだ　たろう】
〒123-4567　東京都～

というデータをエクセルにペーストしました。

A２のセルには
山田　太郎【やまだ　たろう】

A３のセルには
〒123-4567　東京都～

が入力されたとします。

それを
B１とC1には
山田　太郎

D１には
やまだ　たろう

E１には
123-4567

F１には
東京都～

を入れたいのですがマクロで出来る方法を教えて下さい。

回答No.6

kagakusuki

回答No.5です。

　済みません、前の回答で提示させて頂いたマクロにおいて、「郵便番号が記入されておらず、尚且つ住所・番地の途中に空欄が入力されていた場合」において、F列に住所の一部が表示されないというバグが見つかりましたので、修正版を作りました。

Sub Macro()

Dim i, ra, rb, c1, c2, c3 As Long
Dim s1, s2, s3, s(5) As String

ra = 1: rb = 1
Do While Application.WorksheetFunction. _
CountIf(Range("A" & ra & ":A" & Rows.Count), "*?【*?】")
ra = ra - 1 + Application.WorksheetFunction. _
Match("*?【*?】", Range("A" & ra & ":A" & Rows.Count), 0)
s1 = Range("A" & ra).Value & ""
s2 = Range("A" & ra + 1).Value & ""
c1 = InStr(s1, "【")
c2 = InStr(Left(s2, 5), "-")
c3 = InStr(Replace(s2, "　", " "), " ")
s(0) = Left(s1, c1 - 1)
s(1) = s(0)
s(2) = Replace(Mid(s1, c1 + 1), "】", "")
s3 = ""
If c2 > 3 And c3 > c2 Then _
s3 = Replace(Replace(Left(s2, c3 - 1), "〒", ""), "-", "")
If s3 = "" Then c3 = 0
s(3) = ""
If IsNumeric(s3) Then s(3) = Format(s3, "000-0000")
s(4) = Trim(Mid(s2, c3 + 1))
For i = 0 To 4
Range("B" & rb).Offset(0, i).Value = s(i)
Next i
ra = ra + 1
rb = rb + 1
Loop
Range("B" & rb & ":F" & Rows.Count).ClearContents

End Sub

お礼

おはようございます。
No.5様の通りにやってみたのですが
このような結果になってしまいました。

Sub Macro()からEnd Subまでをコピー→sheet1右クリック→コードの表示→ペースト→
閉じる→サイトの情報画面をコピー→sheet1のA1にペースト→Alt F8→実行

私のやり方がおかしかったのでしょうか、、、？

http://www.fastpic.jp/images.php?file=4058255675.jpg

せっかくお答えいただいたのに申し訳ございません。

補足

何度もお答えいただきありがとうございます。
朝から、まずはNO3様のご回答に対応しようと頑張っておりましたが
kagakusuki様のご回答までたどり着けずの状態です。

今しばらくお待ちいただけたらと思います。

又、NO3様のご回答に補足をさせていただきましたので
よければご覧いただけたらと思います。