データ抽出について教えて下さい。

質問

以前質問し、マクロを作って頂いたのですが、行と列を挿入しなくてはならなくなり、マクロが機能しなくなってしまいました。

●以前の質問●
セルA1：カベシタジゴウハン 9X 50X1800 D9
セルA2：ウケゴウハン T5.5 40X 300 U7
セルA3：ゴウハンK 2.5X 60X 80 スペーサー
セルA4：ランバP *412X3547 W2
セルA5：VSF K 12.5X 47X 869 LE
セルA6：VSF J*12X 68X2395 Wメン WX

とシートに入っているとします。これを、

セルB1：9　 セルC1：50　 セルD1：1800
セルB2：5.5　 セルC2：40　 セルD2：300
セルB3：2.5　 セルC3：60　 セルD3：80
セルB4：空白 セルC4：412　セルD4：3547
セルB5：12.5 セルC5：47　 セルD5：869
セルB6：12　 セルC6：68　 セルD6：2395

と入るように関数を使うにはどうしたら良いでしょうか。
マクロでも構いません。

●採用させて頂いた回答●
Sub test()
Dim i, ii, iii
Dim a As String
For i = 1 To Range("a65536").End(xlUp).Row
a = ""
iii = 0
For ii = 1 To Len(Cells(i, 1).Value)
If IsNumeric(Mid(Cells(i, 1).Value, ii, 1)) Or Mid(Cells(i, 1).Value, ii, 1) = "." Then
a = a & Mid(Cells(i, 1).Value, ii, 1)
ElseIf a <> "" Then
Cells(i, 2).Offset(, iii).Value = a
a = ""
iii = iii + 1
End If
If iii = 3 Then Exit For
Next ii
Next i
End Sub

●今回セルが変わりました●
セルB2：カベシタジゴウハン 9X 50X1800 D9
セルB3：ウケゴウハン T5.5 40X 300 U7
セルB4：ゴウハンK 2.5X 60X 80 スペーサー
セルB5：VSF K 12.5X 47X 869 LE
セルB6：VSF J*12X 68X2395 Wメン WX

とシートに入っています。これを、

セルC2：9　 セルD2：50　 セルE2：1800
セルC3：5.5　 セルD3：40　 セルE3：300
セルC4：2.5　 セルD4：60　 セルE4：80
セルC5：12.5 セルD5：47　 セルE5：869
セルC6：12　 セルD6：68　 セルE6：2395

このように入るようにしたいのです。
以前採用させて頂いたマクロを修正したいのですが、どうも自分では失敗してしまいます。
お力をお貸し頂ければ幸いです。

回答No.2

n-jun · ベストアンサー

＃１です。

＞Mid(Cells(i, 2).Value, ii, 2)
は
Mid(Cells(i, 2).Value, ii, 1)
でしょうね。

CellsプロパティとMid関数を一緒にしちゃってます。
ii,1　の1は１文字を選んでいる（判定のために）だけで、Ａ列という意味ではないですよ。

Mid(string, start[, length])
string：文字列を指定。（この場合Cells(i,2).Value）
start：文字列の何文字目かを指定。（この場合iiで決まる）
length：取り出す文字数を指定。（この場合１文字ずつ判定する必要があるので1）
～ＶＢＡヘルプを参照～

お礼

わぁ！出来ました。

重ね重ねご迷惑をおかけしました。
ありがとうございました。

回答No.1

n-jun

Cells(行番号,列番号)　ですから、
Cells(i,1)　の時は１列目（Ａ列）のi行目となります。

Ｂ列にしたい場合は、
Cells(i,2)　で２列目（Ｂ列）のi行目となります。

あとは範囲で"a65536"が"b65536"となる。

こんな感じではないかと。

補足

n-jun様
ご回答ありがとうございます。

Sub test()
Dim i, ii, iii
Dim a As String
For i = 1 To Range("b65536").End(xlUp).Row
b = ""
iii = 0
For ii = 1 To Len(Cells(i, 2).Value)
If IsNumeric(Mid(Cells(i, 2).Value, ii, 2)) Or Mid(Cells(i, 2).Value, ii, 2) = "." Then
b = b & Mid(Cells(i, 2).Value, ii, 2)
ElseIf b <> "" Then
Cells(i, 2).Offset(, iii).Value = b
b = ""
iii = iii + 1
End If
If iii = 3 Then Exit For
Next ii
Next i
End Sub

と訂正しましたところ、うまくいきませんでした。
どこが出来ていないのでしょう…
お忙しい中申し訳ありませんが、ご指摘お願いします。