Public Sub Spl()
     Dim x, n&, i&
     Dim arr(), qwe()
     If Selection.Columns.Count > 1 Then Exit Sub
     Application.ScreenUpdating = 0
     n& = Selection.Rows.Count
     For i = n To 1 Step -1
         With Selection(i)
             x = Split(.Value, ", ")
             Dim r$: r = IIf(Application.ReferenceStyle = xlR1C1, "r", "")
             ReDim arr(0)
             Dim m&: m = 0
             For Each qq In x
                 m = m + 1
                 On Error Resume Next
                 qwe = Evaluate("row(" & Replace(qq, "-", r & ":") & IIf(InStr(1, qq, "-"), "", r & ":" & qq) & ")")
                 ReDim Preserve arr(UBound(arr) + UBound(qwe) + (m = 1))
                 For j = UBound(qwe) To 1 Step -1
                     arr(UBound(arr) - j + 1) = Application.Transpose(qwe)(UBound(qwe) - j + 1)
                 Next
             Next
             If Len(.Value) * UBound(arr) And Err.Number = 0 Then
                 Rows(.Row).Offset(1, 0).Resize(UBound(arr)).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromRightOrBelow
                 .EntireRow.Copy Rows(.Row).Offset(1, 0).Resize(UBound(arr))
                 Range(.Address).Resize(UBound(arr) + 1, 1).Value = WorksheetFunction.Transpose(arr)
             End If
         End With
     Next
     Application.ScreenUpdating = 1
End Sub

Public Sub Spl()
     Dim x, n&, i&
     Dim arr(), qwe()
     If Selection.Columns.Count > 1 Then Exit Sub
     Application.ScreenUpdating = 0
     n& = Selection.Rows.Count
     For i = n To 1 Step -1
         With Selection(i)
             x = Split(.Value, ", ")
             Dim r$: r = IIf(Application.ReferenceStyle = xlR1C1, "r", "")
             ReDim arr(0)
             Dim m&: m = 0
             For Each qq In x
                 m = m + 1
                 'On Error Resume Next
                 qwe = Evaluate("row(" & r & "1:" & r & IIf(InStr(1, qq, "-"), Abs(Evaluate(qq)) + 1, 1) & ")-1+" & Split(qq, "-")(0))
                 ReDim Preserve arr(UBound(arr) + UBound(qwe) + (m = 1))
                 For j = UBound(qwe) To 1 Step -1
                     arr(UBound(arr) - j + 1) = WorksheetFunction.Transpose(qwe)(UBound(qwe) - j + 1)
                 Next
             Next
             If Len(.Value) * UBound(arr) And Err.Number = 0 Then
                 Rows(.Row).Offset(1, 0).Resize(UBound(arr)).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromRightOrBelow
                 .EntireRow.Copy Rows(.Row).Offset(1, 0).Resize(UBound(arr))
                 Range(.Address).Resize(UBound(arr) + 1, 1).Value = WorksheetFunction.Transpose(arr)
             End If
         End With
     Next
     Application.ScreenUpdating = 1
End Sub

Sub Rio_Roll()

Dim ArrA
Dim ArrX As Basic_Data
Dim StrX As String
Dim RowX As Long
Dim Size As Long
Dim a As Long
Dim i As Long
Dim j As Long

a = Cells(Rows.Count, 1).End(xlUp).Row - 2
ArrA = Range(Cells(2, 1), Cells(a + 2, 6))
ReDim ArrX.Row(a)

For i = 0 To UBound(ArrX.Row)
     With ArrX.Row(i)
         .Name = ArrA(i + 1, 1)
         .Number = ArrA(i + 1, 2)
         StrX = ArrA(i + 1, 3)
         .Code = StrToArr_Convertor(StrX)
         .Amount = ArrA(i + 1, 4)
         .Growth = ArrA(i + 1, 5)
         .Date = ArrA(i + 1, 6)
         Size = Size + UBound(.Code) + 1
     End With
Next i

ReDim ArrA(Size - 1, 5)

For i = 0 To UBound(ArrX.Row)
     With ArrX.Row(i)
         For j = 0 To UBound(.Code)
             ArrA(RowX, 0) = .Name
             ArrA(RowX, 1) = .Number
             ArrA(RowX, 2) = .Code(j)
             ArrA(RowX, 3) = .Amount
             ArrA(RowX, 4) = .Growth
             ArrA(RowX, 5) = .Date
             RowX = RowX + 1
         Next j
     End With
Next i

Cells(2, 1).Resize(Size, 6).Value = ArrA

End Sub