调换word表格中内容顺序

buxiaodea

各位大神：因工作需要，我想要把表格中的“二、检测机器运行状况的内容”和“三、检查零配件库存”的内容互换位置，我的想法是求得“二、检测机器运行状况的内容”和“三、检查零配件库存”所在的段落位置，然后将“二、检测机器运行状况的内容”剪切到“四、将问题上报维修部”，就是不知道这个代码该怎么写，麻烦指导一下，谢谢！

limonet

用替换吧：(二、*^13*^13*^13)(三、*^13*^13)

3190496160

Sub da()
Application.ScreenUpdating = False
Dim WordApp As Object '定义Word Application
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Dim worddoc As Object '定义文档
Set worddoc = WordApp.Documents.Open(ThisWorkbook.Path & "\表格.docx")
With WordApp.Selection
    .HomeKey unit:=6, Extend:=wdMove '’wdStory '光标置于文件首
    If .Find.Execute(FindText:="二、检测机器运行状况", Forward:=True) Then '查找到指定字符串
        .Text = "三、检查零配件库存" '替换字符串
    End If
    If .Find.Execute(FindText:="三、检查零配件库存", Forward:=True) Then '查找到指定字符串
        .Text = "二、检测机器运行状况" '替换字符串
    End If
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

求助.rar (23.56 KB, 下载次数: 6)

2024-5-11 11:26 上传

点击文件名下载附件

3190496160

没有不要剪切，互相替换就行了

buxiaodea

3190496160 发表于 2024-5-11 11:26

谢谢大神指导，可能是我问题没有表述清楚：我需要把“二、检测机器运行状况”和“三、检查零配件库存”和它们对应的内容都调换位置，不是只替换标题。实际工作中，只有这两个标题是固定的，下面的内容都不一样，所以我想用剪切来实现这个功能，不知道有没有方法

3190496160

buxiaodea 发表于 2024-5-11 13:49
谢谢大神指导，可能是我问题没有表述清楚：我需要把“二、检测机器运行状况”和“三、检查零配件库存”和 ...

按目前的思路稍加修改也可实现你的效果的嘛

buxiaodea

3190496160 发表于 2024-5-11 13:59
按目前的思路稍加修改也可实现你的效果的嘛

多次使用替换吗，我也想学习一下 这个连续段落选择，麻烦指导一下

gwjkkkkk

buxiaodea 发表于 2024-5-11 14:10
多次使用替换吗，我也想学习一下 这个连续段落选择，麻烦指导一下

https://club.excelhome.net/threa ... tml?_dsign=938db964

taller

1. Option Explicit
   
2. ' 为了保留原格式，使用拷贝粘贴方式换位
   
3. Sub demo()
   
4.     Dim rCell As Range, aWord, aPos() As Long, i As Long, rSrc As Range
   
5.     Dim sTxt As String, Cnt As Long
   
6.     Set rSrc = ActiveDocument.Tables(1).Cell(2, 1).Range
   
7.     aWord = Split("二、 三、 四、")
   
8.     Cnt = UBound(aWord)
   
9.     ReDim aPos(Cnt)
   
10.     For i = 0 To Cnt
    
11.         Set rCell = rSrc.Duplicate
    
12.         If rCell.Find.Execute(FindText:=aWord(i), Forward:=True) Then
    
13.             aPos(i) = rCell.Start
    
14.         End If
    
15.     Next
    
16.     With ActiveDocument
    
17.         Set rCell = .Range(aPos(0), aPos(1))
    
18.         If aPos(Cnt) = 0 Then '四、不存在
    
19.             aPos(Cnt) = rSrc.End - 1
    
20.             ActiveDocument.Range(aPos(2), aPos(2)).InsertParagraph
    
21.             aPos(Cnt) = aPos(Cnt) + 1
    
22.         End If
    
23.         rCell.Copy
    
24.         .Range(aPos(2), aPos(2)).Paste
    
25.         rCell.Text = ""
    
26.     End With
    
27. End Sub

复制代码