Sub test1()
Dim h
Dim j As Integer
j = 0
Dim n1 As Integer '分行单元格在第几列
Dim m1 As Integer '填充到的列
Dim p As Integer '所有内容的列数
n1 = 1
m1 = 2
p = 4
'Application.ScreenUpdating = False
'For i = 1 To Range("a65536").End(xlUp).Row
For i = 2 To 16 '如果不能完全填充,加大这里的行数
'MsgBox i
i = i + j
h = Split(Cells(i, n1), ",") '如果需要根据多个标点符号分行,可以复制出一列,然后选择分行后粘贴到分行前的那一列进行覆盖,其余列正常填充空格,在每次分行时根据需求修改分行条件(这里按逗号分行,标点符号区分中英文)
'MsgBox i
'MsgBox UBound(h)
If UBound(h) > 0 Then
Rows(i + 1).Resize(UBound(h)).Insert
Cells(i, m1).Resize(UBound(h) + 1, 1) = Application.Transpose(h)
j = UBound(h)
'MsgBox UBound(h)
For num = 1 To j
For column = 1 To p '此循环为了控制粘贴值的列数,有多少列值需要复制就to 多少,哪里是填充拆分值的列,就在内层if处理,不进行向下填充
If column = m1 Then '如果填充的是拆分填充的列,只要复制等于原单元格值即可,因为上一步拆分已做填充
Cells(i, column) = Cells(i, column)
Else '如果不是,则空单元格等于上一列值,num为之前每列添加空格的个数,通过num的for循环可以一一进行填充
Cells(i + num, column) = Cells(i, column)
End If
Next
Next
Else
Cells(i, m1) = Application.Transpose(h)
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