Excel批量替换Word文本异常：新文本追加而非覆盖替换

你的代码出现替换异常的核心原因是依赖选区（Selection）操作查找替换，且破坏了查找的上下文环境，具体问题点：

• 用Selection.Find执行查找，每次操作后手动修改选区内容、移动光标，导致后续查找只能从当前光标位置开始，无法覆盖整个文档
• Find.Execute未指定Replace参数，默认不会自动完成替换操作
• 手动设置Selection = info属于画蛇添足，会直接在当前选区位置插入内容，而非替换目标文本

修正后的代码 #

Option Explicit
Sub ReplaceText()
    Dim wApp As Object
    Dim wDoc As Object
    Dim i As Integer
    Dim keyword As String
    Dim info As String
    ' 定义Word常量（后期绑定需手动声明）
    Const wdReplaceAll As Integer = 2
    Const wdFormatXMLDocument As Integer = 12
    
    Set wApp = CreateObject("Word.Application")
    wApp.Visible = True
    wApp.DisplayAlerts = False
    
    Set wDoc = wApp.Documents.Open("你的文件路径")
    
    For i = 3 To 73
        keyword = Worksheets("Word").Cells(i, 2).Value
        info = Worksheets("Word").Cells(i, 3).Value
        
        ' 跳过空关键词避免无效操作
        If keyword <> "" Then
            With wDoc.Content.Find
                .ClearFormatting
                .Replacement.ClearFormatting
                .Text = keyword
                .Replacement.Text = info
                .MatchCase = True
                .MatchWholeWord = True
                .Execute Replace:=wdReplaceAll
            End With
        End If
    Next i
    
    wDoc.SaveAs2 Filename:="保存的文件路径", _
                 FileFormat:=wdFormatXMLDocument, AddtoRecentFiles:=False
    wDoc.Close
    wApp.Quit
    Set wDoc = Nothing
    Set wApp = Nothing
End Sub

关键修改说明 #

• 改用wDoc.Content.Find：基于整个文档内容执行查找，而非依赖当前选区，确保每次查找都覆盖全文档
• 补充Replace:=wdReplaceAll：明确执行全文档替换操作，无需手动处理选区
• 移除Selection相关操作：删除Application.Selection = info和Selection.EndOf这类破坏查找上下文的代码
• 添加常量定义：因为用了CreateObject（后期绑定），Excel中没有Word的内置常量，需手动声明
• 增加空值判断：避免关键词为空时执行无效查找
• 最后关闭文档和Word进程：防止后台残留Word实例

内容的提问来源于stack exchange，提问作者Kahf Khaze