|
- Option Explicit
- ' 为了保留原格式,使用拷贝粘贴方式换位
- Sub demo()
- Dim rCell As Range, aWord, aPos() As Long, i As Long, rSrc As Range
- Dim sTxt As String, Cnt As Long
- Set rSrc = ActiveDocument.Tables(1).Cell(2, 1).Range
- aWord = Split("二、 三、 四、")
- Cnt = UBound(aWord)
- ReDim aPos(Cnt)
- For i = 0 To Cnt
- Set rCell = rSrc.Duplicate
- If rCell.Find.Execute(FindText:=aWord(i), Forward:=True) Then
- aPos(i) = rCell.Start
- End If
- Next
- With ActiveDocument
- Set rCell = .Range(aPos(0), aPos(1))
- If aPos(Cnt) = 0 Then '四、不存在
- aPos(Cnt) = rSrc.End - 1
- ActiveDocument.Range(aPos(2), aPos(2)).InsertParagraph
- aPos(Cnt) = aPos(Cnt) + 1
- End If
- rCell.Copy
- .Range(aPos(2), aPos(2)).Paste
- rCell.Text = ""
- End With
- End Sub
复制代码 |
评分
-
1
查看全部评分
-
|