Sub RazdelRow()
Dim i As Long
Dim iLastRow As Long
Dim n As Integer
Dim arr
 iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
   For i = iLastRow To 2 Step -1
     If InStr(1, Cells(i, "C"), ";") <> 0 Then
       arr = Split(Cells(i, "C"), ";")
     End If
     If InStr(1, Cells(i, "C"), ",") <> 0 Then
       arr = Split(Cells(i, "C"), ",")
     End If
       For n = UBound(arr) To 0 Step -1         'вставляем с конца массива  arr
         Rows(i + 1).Insert
         Cells(i + 1, "C") = arr(n)
         Range("A" & i & ":B" & i).Copy Range("A" & i + 1)
         Range("D" & i).Copy Range("D" & i + 1)
       Next
         Rows(i).Delete
   Next
End Sub

Sub mrshkei()
Dim arr, arr2, i As Long, n As Long, j As Long, lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("A2:D" & lr): ReDim arr3(1 To lr * 10, 1 To 4): k = 1
For i = LBound(arr) To UBound(arr)
    arr2 = Split(arr(i, 3), ";")
    If UBound(arr2) = 0 Then arr2 = Split(arr(i, 3), ",")
    If UBound(arr2) = 0 Then
        For j = 1 To 4
            arr3(k, j) = Trim(arr(i, j))
        Next j
        k = k + 1
    Else
        For n = LBound(arr2) To UBound(arr2)
            arr3(k, 1) = arr(i, 1)
            arr3(k, 2) = arr(i, 2)
            arr3(k, 3) = Trim(arr2(n))
            arr3(k, 4) = arr(i, 4)
            k = k + 1
        Next n
    End If
Next i
Range("A2").Resize(UBound(arr3), 4) = arr3
End Sub

Sub RazdelRow1(): Dim vTp1, vTp2, TP, Rm1&, i&, j&, n&
    vTp1 = Cells(1).CurrentRegion
vTp1 = Application.WorksheetFunction.Transpose(vTp1)
    Rm1 = UBound(vTp1): n = 1: vTp2 = vTp1
For i = 1 To UBound(vTp1, 2)
    TP = Split(vTp1(3, i), ",")
If UBound(TP) = 0 Then TP = Split(vTp1(3, i), ";")
ReDim Preserve vTp2(1 To Rm1, 1 To n + UBound(TP))
    For k = 0 To UBound(TP)
        For j = 1 To Rm1
If j = 3 Then vTp2(j, n) = TP(k) Else vTp2(j, n) = vTp1(j, i)
        Next j
    n = n + 1
    Next k
Next i
[F1].Resize(UBound(vTp2, 2), UBound(vTp2, 1)) = Application.WorksheetFunction.Transpose(vTp2)
End Sub