Sub test1()
Dim h
Dim j As Integer
j = 0  '用于辅助循环的进行,可以在拆分行获取下一个需要拆分单元格的行号
'Application.ScreenUpdating = False
'For i = 1 To Range("a65536").End(xlUp).Row
For i = 1 To 50  '循环结束值至少等于拆分后的行数,否则会没有分完就跳出循环,导致最后部分无法拆分
'MsgBox i
i = i + j
h = Split(Cells(i, 1), ",")  '把i行1列的单元格内容把逗号前后内容以数组的形式存储到h
'MsgBox i
'MsgBox UBound(h)
If UBound(h) > 0 Then
Rows(i + 1).Resize(UBound(h)).Insert    '在i+1行上插入UBound(h)行空行,UBound(h)获取数组h的最大下标,数组默认下标从0开始,所以需要if判断,当数组存在两个值或以上才执行空行插入
Cells(i, 2).Resize(UBound(h) + 1, 1) = Application.Transpose(h)   'Transpose(h)转置函数,把数组h按列填充,resize(n,m)函数把活动单元格变成n行m列
j = UBound(h)
'MsgBox UBound(h)

For num = 1 To j
Cells(i + num, 1) = Cells(i, 1)   '通过循环输入1列也就是被拆分行出现的空格,可达到分行后进行结果的追溯,是从哪个值拆出来额
Next
Else
Cells(i, 2) = Application.Transpose(h)  ' cells函数第一个参数决定赋值到第几行,第二个参数决定赋值到第几列
j = 0
End If
'If i < 2 Then
'j = UBound(h)
'MsgBox "right"
'Else
'j = UBound(h)
'End If
Next
'Application.ScreenUpdating = True


End Sub

红尘往事,一切随风!