エクセルでカンマ区切り文字を各行に分解するマクロを書きたい

質問

WindowsXP Excel2003

エクセルで以下ができるマクロを書きたいです。

B列にはカンマ区切りで文字列が入っています。
カンマ区切りの数は行によって様々です。
この表をB列のカンマ区切り文字を各行に分解したいです。
その際、A列とC列は分解前の値と同様です。
このようなマクロは書けますかね？

A列　　　　　B列　　　　　C列
あ　　　　　a,b,c　　　　100
い　　　　　d,e　　　　　200
う　　　　　f　　　　　　300
え　　　　　g,h　　　　　400

　　　　↓

A列　　　　　B列　　　　　C列
あ　　　　　a　　　　　　100
あ　　　　　b　　　　　　100
あ　　　　　c　　　　　　100
い　　　　　d　　　　　　200
い　　　　　e　　　　　　200
う　　　　　f　　　　　　300
え　　　　　g　　　　　　400
え　　　　　h　　　　　　400

回答No.2

watabe007 · ベストアンサー

Sub Test()
　　Dim v As Variant
　　Dim i As Long, j As Long

　　For i = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
　　　　v = Split(Cells(i, "B").Value, ",")
　　　　If UBound(v) > 0 Then
　　　　　　Rows(i).Offset(1).Resize(UBound(v)).Insert
　　　　　　For j = LBound(v) To UBound(v)
　　　　　　　　Cells(i + j, "A").Value = Cells(i, "A").Value
　　　　　　　　Cells(i + j, "B").Value = v(j)
　　　　　　　　Cells(i + j, "C").Value = Cells(i, "C").Value
　　　　　　Next
　　　　End If
　　Next
End Sub

お礼

すごい！こちらもできました！
助かりました～
どうもありがとうございました。

回答No.1

okormazd

下記コード。
E列以下を作業列に使っているので、邪魔なら邪魔じゃないところに移動してください。c+3のところ。

Sub test()

s0 = ","
r = 1
c = 2

str1 = Cells(r, c)
While str1 <> ""
l = Len(str1)
n = 0
For i = 1 To l
s1 = Mid(str1, i, 1)
If s1 = s0 Then
n = n + 1
End If
Next

If n > 0 Then
Cells(r, c).TextToColumns Destination:=Cells(r, c + 3), DataType:=xlDelimited, Comma:=True

For i = 1 To n
Cells(r + 1, c).EntireRow.Insert
Next

Range(Cells(r, c + 3), Cells(r, c + 3 + n)).Copy
Cells(r, c).PasteSpecial Paste:=xlPasteAll, Transpose:=True

Cells(r, 1).AutoFill Destination:=Range(Cells(r, 1), Cells(r + n, 1))
Cells(r, c + 1).AutoFill Destination:=Range(Cells(r, c + 1), Cells(r + n, c + 1))

Range(Cells(r, c + 3), Cells(r + n - 1, c + 3 + n)).ClearContents
End If

r = r + n + 1
str1 = Cells(r, c)

Wend

End Sub

お礼

できました！助かります。
ありがとうございます！