text 拆分选中的表格-8-13

Posted 2021-05-02

Sub splitSelectCells()

  Selection.Range.HighlightColorIndex = wdBrightGreen
  Selection.Collapse wdCollapseStart

Dim a, b As Integer
a = Selection.Tables(1).Columns.count
b = Selection.Tables(1).Range.Cells.count
If Asc(Selection.Tables(1).Cell(b, a).Range.Text) = 13 Then
  Selection.Tables(1).Cell(b, a).Range.Text = "WAITDELET"
End If
Selection.Tables(1).Cell(b, a).Range.HighlightColorIndex = wdRed

  Call SplitCells
End Sub
Sub SplitCells()
Application.ScreenUpdating = False
Dim tt As Single
tt = Timer
Dim selT As String
Dim arr
Dim i, j As Integer
Dim TC As Integer
Dim columnsC As Integer





Do
  
    selT = Selection.Range.Cells(1).Range.Text
    If Len(selT) > 5 And Selection.Range.HighlightColorIndex = wdBrightGreen Then
    If Selection.Cells(1).Range.Paragraphs.count > 1 Then
  
  
    arr = Split(selT, ChrW(13))
    Dim p As Integer
    p = Selection.Cells(1).Range.Paragraphs.count
    Selection.Range.Cells(1).Range.Cut
    Selection.Cells.Split Numrows:=p, Numcolumns:=1, MergeBeforeSplit:=False
  
    Selection.MoveRight wdCell, 2
    
      For j = 0 To UBound(arr) - 1
      
        Dim oriS, doneS As String
        oriS = Selection.Paragraphs(1).Range.Text
     If j = 0 Then
      Selection.MoveLeft wdCell, 1
       End If
       
      doneS = Selection.Paragraphs(1).Range.Text
        If j <> 0 Then
        If oriS = doneS Then
          Selection.MoveDown wdLine, 1
        End If
        End If

      Selection.TypeText arr(j)
      Next
      
      
      Selection.MoveRight unit:=wdCell
      
      ElseIf Selection.Range.Next(wdParagraph, 2).Information(wdWithInTable) Then
    
      Selection.MoveRight unit:=wdCell
      
  End If
  Else

    Selection.MoveRight unit:=wdCell
  End If

  

Loop While Selection.Range.HighlightColorIndex <> wdRed


If Selection.Range.HighlightColorIndex = wdRed Then
    selT = Selection.Range.Cells(1).Range.Text
    If Left(selT, 4) = "WAIT" Then
      Selection.Range.Cells(1).Range.Text = ""
    End If
    
    If Len(selT) > 5 Then
    If Selection.Cells(1).Range.Paragraphs.count > 1 Then
    arr = Split(selT, ChrW(13))
    p = Selection.Cells(1).Range.Paragraphs.count
    Selection.Range.Cells(1).Range.Cut
    Selection.Cells.Split Numrows:=p, Numcolumns:=1, MergeBeforeSplit:=False
    
    Selection.MoveLeft wdCell, 2
    For j = 0 To UBound(arr) - 1
    oriS = Selection.Paragraphs(1).Range.Text
    If j = 0 Then
    Selection.MoveRight wdCell, 1
    End If
       
      doneS = Selection.Paragraphs(1).Range.Text
        If j <> 0 Then
        If oriS = doneS Then
          Selection.MoveDown wdLine, 1
        End If
        End If

    Selection.TypeText arr(j)
    Next
    Else
  End If
  Else
  End If
End If
Selection.Tables(1).Range.HighlightColorIndex = wdAuto
Application.ScreenUpdating = True
End Sub