Ich habe Daten in Excel in Form von
cell1 | cell2
1 | A, B, C
2 | A, D
Und ich möchte die durch Kommas getrennten Daten in neue Zeilen aufteilen.
Mögen,
cell1 | cell2
1 | A
1 | B
1 | C
2 | A
2 | D
Irgendwelche Tipps?
Ändern von Jooks Antwort.
Public Sub solutionJook()
Dim arr() As Variant
Dim arrSum() As Variant
Dim arrResult() As Variant
Dim arrTemp As Variant
Dim i As Long
Dim j As Long
Dim h As Long
Dim lngSplitColumn As Long
'input of array to seperate
arr = Range("A2:C3")
'specify which column has the values to be split up
lngSplitColumn = 2
'using the boundries of the given range,
'arrSum has now always the right boundries for the first dimension
ReDim Preserve arrSum(LBound(arr, 2) To UBound(arr, 2), 1 To 1)
'create the array with seperated A B C
For i = LBound(arr, 1) To UBound(arr, 1)
'use split to make A B C into an array, using 'enter' (chr(10)) as indicator
arrTemp = Split(arr(i, lngSplitColumn), " | ")
'every value of arrTemp creates a new row
For j = LBound(arrTemp) To UBound(arrTemp)
'loop through all input columns and create the new row
For h = LBound(arr, 2) To UBound(arr, 2)
If h = lngSplitColumn Then
'setup the value of the splitted column
arrSum(h, UBound(arrSum, 2)) = arrTemp(j) 'set A,B,C
Else
'setup the value of any other column
arrSum(h, UBound(arrSum, 2)) = arr(i, h) 'set Value of Column h
End If
Next h
ReDim Preserve arrSum(LBound(arr, 1) To UBound(arr, 2), _
LBound(arrSum, 2) To (UBound(arrSum, 2) + 1))
Next j
Next i
'clean up last empty row (not realy necessary)
ReDim Preserve arrSum(LBound(arr, 1) To UBound(arr, 2), _
LBound(arrSum, 2) To (UBound(arrSum, 2) - 1))
'setup transposed result array
ReDim arrResult(LBound(arrSum, 2) To UBound(arrSum, 2), _
LBound(arrSum, 1) To UBound(arrSum, 1))
'transpose the array
For i = LBound(arrResult, 1) To UBound(arrResult, 1)
For j = LBound(arrResult, 2) To UBound(arrResult, 2)
arrResult(i, j) = arrSum(j, i)
Next j
Next i
'specify target range
Range(Cells(1, 5), Cells(UBound(arrResult, 1), 4 + UBound(arrResult, 2))) = arrResult
End Sub