エクセルの文字８桁を１桁づつに分ける

エクセルの表のＡ欄に文字が８桁入っています。その各文字を１文字ずつＢ欄Ｃ欄Ｄ欄に分けたいのです。
Ａ欄に入っている文字は、00089301など半角数字です。
それを、Ｂ欄には、0　　Ｃ欄には0　Ｄ欄には0　Ｅ欄には8・・・・などに分けたいのです。
そんなマクロが組めるのでしょうか？
どなたか教えてください。

No.3 ベストアンサー 回答者： merlionXX 回答日時： 2011/01/24 17:19

一例です。

A1からデータがあるものとします。

Sub test01()
　　Dim c As Range, i As Long
　　For Each c In Range("A1", Range("A1").End(xlDown))
　　　　For i = 1 To Len(c.Value)
　　　　　　c.Offset(, i) = Mid(c.Value, i, 1)
　　　　Next i
　　Next
End Sub

別に８桁に限りません。

No.5 回答者： mshr1962 回答日時： 2011/01/24 17:32

No.1です。

マクロの記録で出来る方法
「マクロの記録」を開始して
開始行(A1)を選択
Ctrl+Shiftを押しながら↓を押す
Ctrlを押しながらCを押してコピー
B1を選択
Ctrlを押しながらVを押して貼り付け
データ、区切り位置で「スペースによって・・・」を選択して「次へ」
数字の各桁をマウスを使って1桁ずつに分割して「完了」
「マクロの記録の終了」

上記で下記のマクロが出来ます。

Sub Macro1()
'
' Macro1 Macro
'

'
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("B1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array _
(5, 1), Array(6, 1), Array(7, 1)), TrailingMinusNumbers:=True
End Sub

No.4 回答者： gyouda1114 回答日時： 2011/01/24 17:25

A1の　00089301　は、文字列であることが必要です。

画像で　
B1に　=MID($A$1,COLUMN(A1),1)
右方向にオートフィル

No.2 回答者： mu2011 回答日時： 2011/01/24 17:13

一例です。

Sub sample()
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
For j = 1 To Len(Cells(i, "A"))
Cells(i, j).Offset(, 1).Value = Mid(Cells(i, "A"), j, 1)
Next
Next
End Sub

No.1 回答者： mshr1962 回答日時： 2011/01/24 17:09

関数でいいなら

B2=MID($A2,COLUMN()-1,1)
としてC2:I2にこの数式をコピー


※A列が文字列でなく数値を表示形式で8桁表示なら
B2=MID(TEXT($A2,"00000000"),COLUMN()-1,1)
としてください。