Vba 将.Find（查找/替换）与轨迹更改一起使用会创建重复项

我正在开发Word VBA宏，以优化编辑人员的Word。他们接收文档并使用跟踪更改进行常规更正，然后原始作者接受（或拒绝）这些编辑

问题是宏使用Find Replace会导致同一单词的重复甚至三次，因为宏会不断检测原始单词并重新替换它

在本例中，公司名称为“NorthWinds”，我们希望查找并修复不正确的大写字母和posessive（NorthWinds、NorthWinds等；加上NorthWinds或NorthWinds；以及northwind或northwind）

示例文本：
这是northwinds的财产
这是northwind的财产
这是NorthWinds的财产
这是NorthWind的财产

在启用轨迹更改的情况下运行宏后的结果：
这是northwinds的northwinds属性
这是northwind的NorthWinds属性
这是NorthWinds的NorthWinds属性
这是NorthWind的NorthWinds属性

宏：

Sub NWFIX()
Selection.HomeKey Unit:=wdStory
Call StrReplace("northwinds' ", "NorthWinds ")
Call StrReplace("northwind's ", "NorthWinds ")
Call StrReplace("NorthWinds.com", "northwinds.com", , True)
Call StrReplace("NorthWinds", "NorthWinds", , True)
Call StrReplace("north winds", "NorthWinds")
End Sub

Sub StrReplace(OldStr As String, NewStr As String, _
Optional WholeWord = False, _
Optional MatchCase = False, _
Optional WildCard = False)

 Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = OldStr
        .Replacement.Text = NewStr
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = MatchCase
        .MatchWholeWord = WholeWord
        .MatchWildcards = WildCard
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

任何正确方向的提示或指示都将不胜感激

• 利昂

莱昂

首先，我建议重新编写它，这样您就不会使用

选择

，而是定义一个范围（

set rng=ActiveDocument.Content

），跨范围查找，并使用

Do While.Found=True

循环在各种情况下进行迭代。这是最佳做法，因为

选择

比较混乱。展望未来，你会发现，范围只是更好，即使他们是一个多一点的工作设置

关于您手头的问题，我相信可以使用将

Wrap=wdFindContinue

替换为

Wrap=wdFindStop

来解决。这当然会在您的选择到达最后一次出现时停止sub，但因为您使用的是

.HomeKey

，所以这不应该是问题

---

我的系统没有O365，因此您必须报告您的结果。

您的示例与Word2016中我的预期一样有效。我得到了更新后的文本，替换后的文本显示了删除线（轨道更改打开），最终版本只有新文本。感谢您的理智检查。我在Word O365 16.0.010730.20280上运行，可以在多个windows和mac系统上复制这些结果。所以我不确定事情会落到哪里。