|
こんにちは。かみちゃん です。
>のようにはなりませんでした。すみませんが、一度この例題でVBAコードをチェックして頂けませんか?
私も勘違いしていましたので、勉強がてらKeinさんのコードを見ました。
下記のようにすると、うまく動くようです。
Sub MyData_Split()
Dim i As Long, j As Long
Dim Ary1() As String, Ary2() As String, Ary3() As String
Dim SpAry As Variant, V As Variant
With Sheets("Sheet1")
For i = 1 To .Range("A1").End(xlDown).Row
If IsEmpty(.Cells(i, 3).Value) Then
ReDim Preserve Ary1(j): Ary1(j) = .Cells(i, 1).Value
ReDim Preserve Ary2(j): Ary2(j) = ""
ReDim Preserve Ary3(j): Ary3(j) = ""
j = j + 1
Else
If Len(.Cells(i, 3).Value) = 1 Then
ReDim Preserve Ary1(j): Ary1(j) = .Cells(i, 1).Value
ReDim Preserve Ary2(j): Ary2(j) = .Cells(i, 2).Value
ReDim Preserve Ary3(j): Ary3(j) = .Cells(i, 3).Value
j = j + 1
Else
SpAry = Split(.Cells(i, 3).Value, ",")
For Each V In SpAry
ReDim Preserve Ary1(j): Ary1(j) = .Cells(i, 1).Value
ReDim Preserve Ary2(j): Ary2(j) = .Cells(i, 2).Value
ReDim Preserve Ary3(j): Ary3(j) = V
j = j + 1
Next
Erase SpAry
End If
End If
Next i
End With
With Sheets("Sheet2")
.Cells(1, 1).Resize(UBound(Ary1) + 1).Value = _
WorksheetFunction.Transpose(Ary1)
.Cells(1, 2).Resize(UBound(Ary2) + 1).Value = _
WorksheetFunction.Transpose(Ary2)
.Cells(1, 3).Resize(UBound(Ary3) + 1).Value = _
WorksheetFunction.Transpose(Ary3)
.Cells(1, 1).CurrentRegion.Borders.LineStyle = 1
End With
Erase Ary1, Ary2, Ary3
End Sub
|
|