目录
注意:因为此问题可以结合大学日常用得较多的Excel,作为存储多个关键词的载体。此文便在Excel中写代码,也方便操作。
一、问题假设
1.待处理文件
假如现在有一个文件夹,里面有一篇Word文档(右);需要检索的词记录在相同文件夹下的另一个Excel工作簿中的Sheet1这张表格的A列(左,第一行是标题,不参与检索),即查找的内容,替换的内容为第B列,C列可以选择是否用通配符替换。
![](https://i-blog.csdnimg.cn/blog_migrate/1fe7c176c200d90aee019d09ace71354.jpeg)
2.假设处理要求
需要将上图所有Word文件中包含Excel表格里的关键词所地方左右加上中括号。
二、关键思路
1.遍历Excel单元格
遍历存放多个关键词的Excel表格“关键词.xlsx”的Sheet1的A列的单元格。
2.Word中查找替换
每个单元格的值作为Word查找的内容,在Word中将查找到的区域标记在中括号内。
参数设置:
![](https://i-blog.csdnimg.cn/blog_migrate/aa71694522e8ceb3353826fab8fd3434.jpeg)
这里前面两个关键词用的是不勾选通配符替换,第三个是通配符替换,有时写法上可能稍有差别。
关于Word(通配符)替换的内容,可以关注我的专栏
Word(通配符)替换https://www.zhihu.com/column/c_1517437402993397760
了解之前收录的更多典型示例。
三、参考代码
Rem 此处以下为主程序
Sub Word批量替换()
Dim sht As Worksheet
Dim wdApp As Object
Dim fd As FileDialog
Dim fso As Object
Dim fName
Dim aDoc
Dim arr
Set sht = ThisWorkbook.Sheets("sheet1")
Set wdApp = CreateObject("Word.Application")
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Set fso = CreateObject("Scripting.FileSystemObject")
arr = sht.Cells(1, 1).CurrentRegion
With fd
.AllowMultiSelect = True
.InitialFileName = ThisWorkbook.Path
.Title = "选择Word文件(可多选)"
.Filters.Clear
.Filters.Add "所有文件", "*.*", 1
.Filters.Add "Word文件", "*.doc*;*.dot*", 2
If .Show Then
Application.ScreenUpdating = False
For Each fName In .SelectedItems
On Error Resume Next
If fso.GetExtensionName(fName) Like "do[ct]*" And Not fName Like "*~$*" Then
Set aDoc = wdApp.Documents.Open(fName)
For i = LBound(arr, 1) + 1 To UBound(arr, 1)
Call 处理过程(aDoc, CStr(arr(i, 1)), CStr(arr(i, 2)), CBool(arr(i, 3)))
Next
aDoc.Close -1
j = j + 1
Debug.Print j, fName, "处理完成"
End If
Next
Application.ScreenUpdating = True
End If
End With
Set sht = Nothing
Set fd = Nothing
Set wdApp = Nothing
Set fso = Nothing
Set aDoc = Nothing
MsgBox Format(j, "完成 共处理了0个Word文件")
End Sub
Rem 此处以下为替换过程
Sub 处理过程(aDoc, findText As String, Optional replaceText As String = "^&", Optional wildCards As Boolean = False)
On Error GoTo err1
With aDoc.Content.Find
.ClearFormatting
.Forward = True
.Wrap = 0
.MatchWildCards = wildCards
.Text = findText
.Replacement.ClearFormatting
.Replacement.Text = replaceText
.Execute Replace:=2
End With
Exit Sub
err1:
Debug.Print Err.Description
End Sub
四、操作步骤及效果
1.步骤
(1)准备
打开Excel工作簿【关键词.xlsm】,同时关闭掉需要处理的Word文件
(2)开始运行
点击Excel表格中的【执 行】或者在代码主程序范围内点击运行按钮
![](https://i-blog.csdnimg.cn/blog_migrate/60d3c211725a8903abf6dd36e993cb07.jpeg)
(3)选择文件
按下图所示:选择要处理的Word文件(可多选),点击【打开】
![](https://i-blog.csdnimg.cn/blog_migrate/15483c848339ccb6d9a6c636efb21b8b.jpeg)
(4)点击确定,处理完成
![](https://i-blog.csdnimg.cn/blog_migrate/3be8a4bb48498374b4ff9dda92a9dd73.jpeg)
注意:因为有一个文件在测试的时候处理了,此处我只选择了2个文件处理,是没有问题的。
2.验证
打开刚刚处理过的Word文件:
发现每一个Word文件第一处符合要求的关键词已经按要求标记/替换完成。
五、代码源文件
链接: https://pan.baidu.com/s/1Z8vL08TljVpBlbAYq_Ly1g?pwd=ypkd 提取码: ypkd 复制这段内容后打开百度网盘手机App,操作更方便哦
![](https://i-blog.csdnimg.cn/blog_migrate/2b710a5c0f1800a67ad457dfecfe894f.jpeg)
打开文件,在表格中填好查找替换相关参数,然后直接点击操作即可。