拆分选中的表格-8-13
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