在MS word中，findall（在主文档中查找）对于长文档来说非常慢，所以如何通过循环一次查找来使用宏来实现

Question

在MS word中，findall（在主文档中查找）对于长文档来说非常慢

findall的优点是它选择了所有找到的单词（即以浅蓝色透明突出显示），然后我可以一次性更改字体或任何其他属性。

但问题是文档非常大（在我的情况下）发现所有需要花费很多时间或者它会挂起。我可以说我不知道​​后台发生了什么

所以我决定使用宏来找到一个单词并循环查找直到最后一次出现该单词并将选择存储在背景中并最终显示所有选择。

所以有可能。

在Microsoft的单词中，我可以按如下方式找到一个单词：

以下宏与此相同：

Sub findawordonce()
'
' Macro6 Macro
'
'
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "PQXY"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
    End With
    Selection.Find.Execute
End Sub

当我使用findNext找到一个单词（例如：word1）时，它会选择一个单词的出现，这个单词默认以透明蓝色突出显示该单词。

我观察到的是：

当我再次使用FindNext时，会选择下一个单词出现，并且前一次出现的选择消失。

我想要的是：

当我再次使用FindNext时，选择该单词的下一个出现，保留先前的选择。

UI无法实现这一点，但宏可以实现。

我希望宏找到一个被选中的单词并再次循环并找到另一个单词并继续累积选择。

我知道我们可以在整个文件中找到一个单词。但我的文件非常大，很多时候都挂了。

Answer 1

你能试试这个反馈吗？

Sub CommandButton1_Click()
'Updated by Extendoffice 20180625
Dim xFileDialog As FileDialog, GetStr(1 To 100) As String '100 files is the maximum applying this code
Dim xFindStr As String
Dim xReplaceStr As String
Dim xDoc As Document
On Error Resume Next
Set xFileDialog = Application.FileDialog(msoFileDialogFilePicker)
With xFileDialog
    .Filters.Clear
    .Filters.Add "All WORD File ", "*.docx", 1
    .AllowMultiSelect = True
    i = 1
    If .Show = -1 Then
        For Each stiSelectedItem In .SelectedItems
            GetStr(i) = stiSelectedItem
            i = i + 1
        Next
        i = i - 1
    End If
    Application.ScreenUpdating = False
    xFindStr = InputBox("Find what:", "hall", xFindStr)
    xReplaceStr = InputBox("Replace with:", "NOTHING", xReplaceStr)
    For j = 1 To i Step 1
        Set xDoc = Documents.Open(FileName:=GetStr(j), Visible:=True)
        Windows(GetStr(j)).Activate
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = xFindStr  'Find What
            .Replacement.Text = xReplaceStr  'Replace With
            .Forward = True
            .Wrap = wdFindAsk
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchByte = True
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        Application.Run macroname:="NEWMACROS"
        ActiveDocument.Save
        ActiveWindow.Close
    Next
    Application.ScreenUpdating = True
End With
MsgBox "Operation end, please view", vbInformation
End Sub