Experimente o código a seguir, ele funcionou no seu exemplo e deve dar um bom começo. Os comentários incluídos devem explicar a funcionalidade o suficiente.
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
'input of array to seperate
arr = Range("A1:B2")
ReDim Preserve arrSum(1 To 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, 2), Chr(10))
For j = LBound(arrTemp) To UBound(arrTemp)
arrSum(1, UBound(arrSum, 2)) = arr(i, 1) 'set Row1
arrSum(2, UBound(arrSum, 2)) = arrTemp(j) 'set A,B,C
ReDim Preserve arrSum(1 To 2, _
LBound(arrSum, 2) To (UBound(arrSum, 2) + 1))
Next j
Next i
'clean up last empty row (not realy necessary)
ReDim Preserve arrSum(1 To 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
Como observação: há certamente espaço para otimização
Esta é a linha mágica - > arrTemp = Split(arr(i, 2), Chr(10))
- graças ao Spilled, você pode transformar facilmente seus dados em uma matriz, usando qualquer caractere como um delimitador. Todas as outras coisas estão próximas para chegar a este array ou transformá-lo no resultado desejado.
Editar: uma versão atualizada, que se adapta mais dinamicamente à sua entrada
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("A1:C2")
'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), Chr(10))
'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