Sub jjj()

    Dim arr(), arrCom
    Dim lr As Long, i As Long, j As Long
    
    Application.ScreenUpdating = False
    
    lr = Columns("H").Find(What:="*", LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Row
    arr() = Range("H1:H" & lr).Value
    
    For i = UBound(arr) To 2 Step -1
        arrCom = Split(arr(i, 1), ",")
        If UBound(arrCom) > 0 Then
            Rows(i).Copy
            Rows(i + 1).Resize(UBound(arrCom)).Insert
            For j = 0 To UBound(arrCom)
                Cells(i + j, "H").Value = arrCom(j)
            Next
        End If
    Next

    Application.CutCopyMode = False
    
    Application.ScreenUpdating = True

End Sub

Sub obrabotka()
Dim ir As Integer
Dim stext As String
Dim chek As Boolean

ir = Cells(Rows.Count, 1).End(xlUp).Row
For q = ir To 2 Step -1
stext = Cells(q, 8).Value
chek = stext Like "*,*"
If chek = True Then
k = 1
For x = 1 To Len(stext)
If Mid(stext, x, 1) = "," Then k = k + 1
Next x
n = 1
r = q
For w = 1 To k
p = InStr(n, stext, ",", vbTextCompare)
If p = 0 Then p = Len(stext) + 1
Rows(r).Copy
Rows(r).Insert (xlShiftDown)

Cells(r, 8).Value = Mid(stext, n, p - n)
n = p + 1
r = r + 1
Next w
Rows(r).Delete xlShiftUp
End If
Next q
End Sub