Sub W()
   ' MsgBox "行数:" & Selection.Rows.Count
    Dim rows_count As Integer
    Dim rows_id As Integer
    Dim column_count As Integer
    column_count = Selection.Columns.Count '获取选择区域的列数
    'MsgBox column_count '打印列数
    rows_id = ActiveCell.Row '获取活动单元格行id，获取列id的是ActiveCell.Count
    rows_count = Selection.Rows.Count '获取选择区域的行数
    Dim str As String
    'str = InputBox("是否进行分列:")
    'MsgBox rows_count
    'MsgBox "行号:" & ActiveCell.Row
     Dim h
    Dim j As Integer
    j = 0  '参数用于填充空格参数作用为使每次拆分都能指向原来需要拆分的行id，因为每次拆分都会影响下一个需要拆分行的行id，所以需要设置拆分后下一个需要拆分的行id应为上一个行id+拆分时候插入的行数
    Dim n1 As Integer '分行单元格在第几列
    Dim m1 As Integer '填充到的列
    Dim p As Integer '所有内容的列数，这里设置所有列数等于单元格选中的列数，下面填充的列数等于这个列数
    Dim p2 As Integer
    n1 = 1 'InputBox("需要根据第几列分行：")，如果需要按其它列分行，可修改参数
    m1 = 1 'InputBox("需要填充到第几列：")，需要填充到分行的列，所有次参数需要与n1相等
    p = column_count 'InputBox("所有内容的列数：")
    p2 = rows_id 'InputBox("从第几行开始分：")
    'p3 = InputBox("按什么分行：")
    'For i = p2 To Range("a65536").End(xlUp).Row  '如果不能完全填充，加大这里的行数
For i = p2 To 10000       'p2 + p
  i = i   '+ j  不需要加j，否则后面需要置0，加j和不加
        'MsgBox i
  Dim zhengze, Rng
  Rng = Cells(i, n1) '把需要拆分的行赋值给Rng，用于正则检索是否存在需要分行的符号
  Set regx = CreateObject("vbscript.regexp")  'VBA正则模块
  With regx
    
    .Global = True  '匹配所有结果集

    .Pattern = "[,，\\/、 ；：+-]+" '写正则表达式
     Set mat = .Execute(Rng)
     If .test(Rng) Then    '匹配到结果则执行拆分，否则不拆分
       For Each mg In mat   '把匹配到的符号，通过循环按每个符号依次拆分，直到把匹配到的值都拆分完
    
        zhengze = mg
        p3 = mg
          h = Split(Cells(i, n1), p3)
        If UBound(h) > 0 Then
          Rows(i + 1).Resize(UBound(h)).Insert '在i+1行插入UBound(h)个空白行
          Cells(i, m1).Resize(UBound(h) + 1, 1) = Application.Transpose(h) '在i行m1列以列形式填充拆分后的值
          j = UBound(h)
          For num = 1 To j    '因为i的值依次加1循环，需要在第一次循环拆分时就填充新加的空行，例：第一行拆分成3行，需要通过两次循环填充新加的空行，当检测第二行时，由于不需要拆分，就不会进入到这里，不会执行填充操作，假如不需要这层循环，空行就不会被填充。
             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  '按第一个值如逗号分完后，需要重置为0，因为需要重新从第一个单元格拆出来的第一个值检测是否还有其它拆分的符号
         End If

        Next
     Else
       Cells(i, m1) = Cells(i, m1)
       'j = 0   '当一开始就检测不到需要拆分行的符号，需要重设参数，否则受上一个拆分值的影响，会跳过一些行不进行拆分，比如第一行拆了3行，第二行不需要拆，这时候原来的第三行的行id为5，如果此时不重置参数j，就会跳到行id为7的行进行拆分，因为参数j会变成1，导致6+1变为7
  End If
   End With
Next
    
End Sub