Sub test1()
    Dim h
    Dim j As Integer
    j = 0
    Dim n1 As Integer '分行单元格在第几列
    Dim m1 As Integer '填充到的列
    Dim p As Integer '所有内容的列数
    Dim p2 As Integer
    n1 = InputBox("需要根据第几列分行：")
    m1 = InputBox("需要填充到第几列：")
    p = InputBox("所有内容的列数：")
    p2 = InputBox("从第几行开始分：")
    p3 = InputBox("按什么分行：")
    'For i = p2 To Range("a65536").End(xlUp).Row  '如果不能完全填充，加大这里的行数
     For i = p2 To 200
        i = i + j
        h = Split(Cells(i, n1), p3) '如果需要根据多个标点符号分行，可以复制出一列，然后选择分行后粘贴到分行前的那一列进行覆盖，其余列正常填充空格，在每次分行时根据需求修改分行条件（这里按p3的值分行，标点符号区分中英文）
        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)
          For num = 1 To j
             For column = 1 To p '此循环为了控制粘贴值的列数，有多少列值需要复制就to 多少，哪里是填充拆分值的列，就在内层if处理，不进行向下填充
             If column = m1 Then
               Cells(i, column) = Cells(i, column)
             Else
               Cells(i + num, column) = Cells(i, column)
             End If
             Next
          Next
        Else
           Cells(i, m1) = Application.Transpose(h)
           j = 0
        End If
    Next
    
    
   
End Sub