VBA Excel/Word查找和替换

我正在开发一个Excel工作表，用于在Word文档中搜索特定实例（a列），并将其替换为单元格B中的实例

我只想更改与搜索条件匹配的第一个实例，并继续通过列循环到下一个实例

我已经写了下面的代码

如果我使用“wdReplaceAll”，它将替换Word文档中的所有特定实例。 如果我使用“wdReplaceOne”，代码将在第一次更改后中断

VBA代码：

Sub Replace()

Dim pathh As String
Dim pathhi As String
Dim oCell  As Integer
Dim from_text As String, to_text As String
Dim WA As Object

pathh = "C:\Users\Rui.Fernandes\Arquivo Rui Fernandes\On.me Documentação\Construção\Documentos Obra Tipo\PGC.10.Ed.1 - Auditorias Internas.doc"

Set WA = CreateObject("Word.Application")
WA.Documents.Open (pathh)
WA.Visible = True

For oCell = 1 To 10
    from_text = Sheets("PTAct").Range("A" & oCell).Value
    to_text = Sheets("PTAct").Range("B" & oCell).Value
    With WA
        .Activate
    With .Selection.Find
      .ClearFormatting
      .Replacement.ClearFormatting

      .Text = from_text
      .Replacement.Text = to_text
      .Execute Replace:=wdReplaceAll
    End With
End With
Next oCell

End sub

---

如何使其满足我的要求？

您执行后期绑定，因此wdReplaceAll和wdReplaceOne将不是您所期望的。有关WdReplace枚举及其值，请查看Word VBA帮助

Sub Replace()

Dim pathh As String
Dim pathhi As String
Dim oCell  As Integer
Dim from_text As String, to_text As String
Dim WA As Object

pathh = "C:\Users\axel\Documents\replacetest.docx"

Set WA = CreateObject("Word.Application")
WA.Documents.Open (pathh)
WA.Visible = True

For oCell = 1 To 10
    from_text = Sheets("PTAct").Range("A" & oCell).Value
    to_text = Sheets("PTAct").Range("B" & oCell).Value
    With WA.ActiveDocument
        Set myRange = .Content
        With myRange.Find
            .Execute FindText:=from_text, ReplaceWith:=to_text, Replace:=1
        End With
    End With
Next oCell

End Sub

问候

---

Axel

您执行后期绑定，因此wdReplaceAll和wdReplaceOne将不是您所期望的。有关WdReplace枚举及其值，请查看Word VBA帮助

Sub Replace()

Dim pathh As String
Dim pathhi As String
Dim oCell  As Integer
Dim from_text As String, to_text As String
Dim WA As Object

pathh = "C:\Users\axel\Documents\replacetest.docx"

Set WA = CreateObject("Word.Application")
WA.Documents.Open (pathh)
WA.Visible = True

For oCell = 1 To 10
    from_text = Sheets("PTAct").Range("A" & oCell).Value
    to_text = Sheets("PTAct").Range("B" & oCell).Value
    With WA.ActiveDocument
        Set myRange = .Content
        With myRange.Find
            .Execute FindText:=from_text, ReplaceWith:=to_text, Replace:=1
        End With
    End With
Next oCell

End Sub

问候

阿克塞尔