在Microsoft Word中，查找和替换功能是一种快速搜索和替换特定文本的高效方法。然而，当您需要替换多个不同的术语时，手动输入每个术语可能会非常耗时。
为了简化此过程，您可以使用Excel创建一个要查找和替换的文本列表，然后通过简单的VBA代码自动完成任务。本教程将指导您如何使用Excel和VBA在一个Word文档中查找和替换多个文本。此外，我还将向您展示如何将其扩展到多个文档，并介绍Kutools的一项强大功能，用于批量文本替换。
使用VBA代码从Excel中查找并替换一个Word文档中的多个文本
使用VBA代码从Excel中查找并替换多个Word文档中的多个文本
如果您只想在一个Word文件中查找和替换一些文本，以下VBA代码可以帮到您。
1. 在Excel工作表中，创建一列包含您想要查找和替换的文本，另一列包含要替换成的文本，如下图所示。然后同时按下Alt+F11键打开Microsoft Visual Basic for Applications窗口。
2. 接着，点击插入 > 模块，复制并将下面的VBA代码粘贴到窗口中。
VBA代码：在单个Word文件中查找和替换多个文本
Sub replace_texts_range_of_cells()
'Updateby ExtendOffice
Dim xWordApp As Word.Application
Dim xDoc As Word.Document
Dim xRng As Range
Dim I As Integer
Dim xFileDlg As FileDialog
On Error GoTo ExitSub
Set xFileDlg = Application.FileDialog(msoFileDialogFilePicker)
xFileDlg.AllowMultiSelect = False
xFileDlg.Filters.Add "Word Document", "*.docx; *.doc; *.docm"
xFileDlg.FilterIndex = 2
If xFileDlg.Show <> -1 Then GoTo ExitSub
Set xRng = Application.InputBox("Please select the lists of find and replace texts (Press Ctrl key to select two same size ranges):", "Kutools for Excel", , , , , , 8)
If xRng.Areas.Count <> 2 Then
MsgBox "Please select two columns (press Ctrl key), the two ranges have the same size.", vbInformation + vbOKOnly, "Kutools for Excel"
GoTo ExitSub
End If
If (xRng.Areas.Item(1).Rows.Count <> xRng.Areas.Item(2).Rows.Count) Or _
(xRng.Areas.Item(1).Columns.Count <> xRng.Areas.Item(2).Columns.Count) Then
MsgBox "Please select two columns (press Ctrl key), the two ranges have the same size.", vbInformation + vbOKOnly, "Kutools for Excel"
GoTo ExitSub
End If
Set xWordApp = CreateObject("Word.application")
xWordApp.Visible = True
Set xDoc = xWordApp.Documents.Open(xFileDlg.SelectedItems.Item(1))
For I = 1 To xRng.Areas.Item(1).Cells.Count
With xDoc.Application.Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = xRng.Areas.Item(1).Cells.Item(I).Value
.Replacement.Text = xRng.Areas.Item(2).Cells.Item(I).Value
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
xDoc.Application.Selection.Find.Execute Replace:=wdReplaceAll
Next
ExitSub:
Set xRng = Nothing
Set xFileDlg = Nothing
Set xWordApp = Nothing
Set xDoc = Nothing
End Sub
3. 粘贴代码后，仍然在Microsoft Visual Basic for Applications窗口中，点击工具 > 引用，见截图：
4. 在弹出的“引用 - VBAProject”对话框中，从列表框中选择Microsoft Word 16.0 Object Library，见截图：
5. 单击确定按钮关闭对话框，现在，按F5键运行此代码，在弹出的浏览窗口中，选择您要替换文本的Word文件，见截图：
6. 然后，单击确定，在接下来的对话框中，按Ctrl键分别选择原始文本和新文本单元格，见截图：
7. 然后，单击确定按钮，现在，指定文档中的文本已被找到并替换为新文本，文件也已打开，您应该保存它以保留更改。
我还创建了一个VBA代码来帮助您在多个Word文档中查找和替换多个文本。请按照以下步骤操作：
1. 打开包含两列值（要替换的值和替换后的值）的Excel文件，如下图所示，然后同时按下Alt+F11键打开Microsoft Visual Basic for Applications窗口。
2. 接着，点击 插入 > 模块，复制并将下面的VBA代码粘贴到窗口中。
VBA代码：在多个Word文件中查找和替换多个文本
Sub FindReplaceAcrossMultipleWordDocuments()
'Updateby ExtendOffice
Dim xWordApp As Word.Application
Dim xDoc As Word.Document
Dim xRng As Range
Dim I As Integer
Dim xFolderDlg As FileDialog
Dim xFSO As Scripting.FileSystemObject
Dim xFile As File
On Error GoTo ExitSub
Set xFolderDlg = Application.FileDialog(msoFileDialogFolderPicker)
If xFolderDlg.Show <> -1 Then GoTo ExitSub
Set xRng = Application.InputBox("Please select the lists of find and replace texts (Press Ctrl key to select two same size ranges", "Kutools for Excel", , , , , , 8)
If xRng.Areas.Count <> 2 Then
MsgBox "Please select two columns (press Ctrl key), the two ranges have the same size", vbInformation + vbOKOnly, "Kutools for Excel"
GoTo ExitSub
End If
If (xRng.Areas.Item(1).Rows.Count <> xRng.Areas.Item(2).Rows.Count) Or _
(xRng.Areas.Item(1).Columns.Count <> xRng.Areas.Item(2).Columns.Count) Then
MsgBox "Please select two columns (press Ctrl key), the two ranges have the same size.", vbInformation + vbOKOnly, "Kutools for Excel"
GoTo ExitSub
End If
Set xFSO = New Scripting.FileSystemObject
Set xWordApp = CreateObject("Word.application")
xWordApp.Visible = True
For Each xFile In xFSO.GetFolder(xFolderDlg.SelectedItems(1)).Files
If VBA.InStr(xFile.Type, "Microsoft Word") > 0 Then
Set xDoc = xWordApp.Documents.Open(xFile.Path)
For I = 1 To xRng.Areas.Item(1).Cells.Count
With xDoc.Application.Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = xRng.Areas.Item(1).Cells.Item(I).Value
.Replacement.Text = xRng.Areas.Item(2).Cells.Item(I).Value
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
xDoc.Application.Selection.Find.Execute Replace:=wdReplaceAll
Next
xDoc.Close wdSaveChanges
End If
Next
xWordApp.Quit
MsgBox "The Find and Replace has been completed", vbInformation + vbOKOnly, "Kutools for Excel"
ExitSub:
Set xRng = Nothing
Set xFolderDlg = Nothing
Set xWordApp = Nothing
Set xDoc = Nothing
End Sub
3. 仍然在Microsoft Visual Basic for Applications窗口中，点击工具 > 引用，在“引用 - VBAProject”对话框中，从列表框中选择Microsoft Word 16.0 Object Library和Microsoft Scripting Runtime选项，见截图：
4. 勾选这两个选项后，单击确定关闭对话框，然后继续按F5键执行此代码，在打开的 浏览窗口中，选择包含您要进行查找和替换操作的Word文档的文件夹，见截图：
5. 单击确定按钮，在弹出的对话框中，按Ctrl键分别选择您要使用的原始文本和新文本列，见截图：
6. 最后，单击确定，这些文件中的原始文本已被替换为新的文本，完成后，会弹出一个对话框，如下图所示：
7. 单击确定关闭对话框。然后您可以前往文件检查转换结果。
在本节中，我将解释如何使用Word本身而不是Excel，通过强大的Kutools for Word批量查找和替换多个Word文档中的文本。您可以高效地搜索特定文本并将其替换为新文本，包括正文、页眉、页脚、批注等，同时还可以根据需要高亮显示结果。
1. 打开一个Word文件，然后点击Kutools Plus > 批量查找和替换，见截图：
2. 在打开的“批量查找和替换”对话框中，请执行以下操作：
3. 创建搜索条件后，点击替换按钮进入预览结果选项卡查看查找和替换结果。见截图：
4. 然后，单击关闭按钮，会弹出一个提示框询问您是否要保存此方案，单击是保存，单击否忽略，见截图：
Kutools for Word 不仅仅是一套工具——它是一个旨在提升您生产力的智能解决方案。通过人工智能驱动的功能和最核心的特性，Kutools 帮助您在更短的时间内完成更多任务：
| 🤖 | Kutools AI 助手：以智能执行为基础，彻底革新数据分析 |代码生成 |自定义公式创建|数据分析与图表生成 |调用Kutools函数…… |
| 热门功能：查找、选中项的背景色或标记重复项 | 删除空行 | 合并列或单元格且不丢失数据 | 四舍五入…… | |
| 高级LOOKUP：多条件VLookup|多值VLookup|多表查找|模糊查找…… | |
| 高级下拉列表：快速创建下拉列表 |依赖下拉列表 | 多选下拉列表…… | |
| 列管理器： 添加指定数量的列 | 移动列 | 切换隐藏列的可见状态 | 比较区域与列…… | |
| 特色功能：网格聚焦 |设计视图 | 增强编辑栏 | 工作簿及工作表管理器 | 资源库（自动文本） | 日期提取 | 合并数据 | 加密/解密单元格 | 按名单发送电子邮件 | 超级筛选 | 特殊筛选（筛选粗体/倾斜/删除线等）…… | |
| 15大工具集：12项 文本工具（添加文本、删除特定字符等）|50+种 图表 类型（甘特图等）|40+实用 公式（基于生日计算年龄等）|19项 插入工具（插入二维码、从路径插入图片等）|12项 转换工具（小写金额转大写、汇率转换等）|7项 合并与分割工具（高级合并行、分割单元格等）| …… |
通过Kutools for Excel提升您的Excel技能，体验前所未有的高效办公。 Kutools for Excel提供300多项高级功能，助您提升效率并节省时间。 点击此处获取您最需要的功能……
Kutools for Office套件包含Excel、Word、Outlook和PowerPoint的插件，以及Office Tab Pro，非常适合跨Office应用团队使用。
