目錄
一、問題假設
1.待處理檔案
2.假設處理要求
二、關鍵思路
1.周遊Excel單元格
2.Word中查找替換
三、參考代碼
四、操作步驟及效果
1.步驟
（1）準備
（2）開始運作
（3）選擇檔案
（4）點選确定，處理完成
2.驗證
五、代碼源檔案
注意：因為此問題可以結合大學日常用得較多的Excel，作為存儲多個關鍵詞的載體。此文便在Excel中寫代碼，也友善操作。
一、問題假設
1.待處理檔案
假如現在有一個檔案夾，裡面有一篇Word文檔（右）；需要檢索的詞記錄在相同檔案夾下的另一個Excel工作簿中的Sheet1這張表格的A列（左，第一行是标題，不參與檢索），即查找的内容，替換的内容為第B列，C列可以選擇是否用通配符替換。
示例檔案夾及其檔案
2.假設處理要求
需要将上圖所有Word檔案中包含Excel表格裡的關鍵詞所地方左右加上中括号。
二、關鍵思路
1.周遊Excel單元格
周遊存放多個關鍵詞的Excel表格“關鍵詞.xlsx”的Sheet1的A列的單元格。
2.Word中查找替換
每個單元格的值作為Word查找的内容，在Word中将查找到的區域标記在中括号内。
參數設定：
查找替換參數
這裡前面兩個關鍵詞用的是不勾選通配符替換，第三個是通配符替換，有時寫法上可能稍有差别。
關于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表格中的【執 行】或者在代碼主程式範圍内點選運作按鈕
開始運作的兩種方法
（3）選擇檔案
按下圖所示：選擇要處理的Word檔案（可多選），點選【打開】
選擇檔案并打開
（4）點選确定，處理完成
點選确定
注意：因為有一個檔案在測試的時候處理了，此處我隻選擇了2個檔案處理，是沒有問題的。
2.驗證
打開剛剛處理過的Word檔案：
發現每一個Word檔案第一處符合要求的關鍵詞已經按要求标記/替換完成。
五、代碼源檔案
連結: https://pan.baidu.com/s/1Z8vL08TljVpBlbAYq_Ly1g?pwd=ypkd 提取碼: ypkd 複制這段内容後打開百度網盤手機App，操作更友善哦
源檔案二維碼
打開檔案，在表格中填好查找替換相關參數，然後直接點選操作即可。