Question

我有一个宏来搜索Word文件中的某些关键字。程序是：

从第二页开始插入文档
使用循环搜索文档中的各种关键字
如果找到关键字，请将其复制到第一页
在完全搜索时删除插入的文件
转到下一个文档

我现在面临的问题是find函数会触发第一页上复制的文本。我尝试从第二页开始定义搜索区域：

Sub HighlightWords()

Dim DocRange As word.Range
PageCount = ActiveDocument.ComputeStatistics(wdStatisticPages)
ActiveDocument.Select
Set DocRange = Selection.Range
Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=2
DocRange.Start = Selection.Bookmarks("\Page").Range.Start
Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=PageCount
DocRange.End = Selection.Bookmarks("\Page").Range.End
Application.ScreenUpdating = False

Options.DefaultHighlightColorIndex = wdYellow
With DocRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Highlight = True
.text = keyword
.Replacement.text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
If DocRange.Find.Found = True Then
ActiveDocument.GoTo(What:=wdGoToLine, Count:=2).Select
Selection.Style = ActiveDocument.Styles("Normal")
Selection.InsertBreak Type:= wdLineBreak
Selection.InsertAfter text:= keyword & "found in " & file.Name
ElseIf DocRange.Find.Found = False Then
End If
End Sub

但是代码仍会在第一页上找到不应发生的关键字。我该如何解决这个问题？

Answer 1

您可以尝试以下方式：

Sub KeyWordFinder()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String, i As Long
Dim DocSrc As Document, DocTgt As Document, StrFnd As String, StrOut As String
strFolder = GetFolder: If strFolder = "" Then Exit Sub
Set DocTgt = ThisDocument: strDocNm = DocTgt.FullName
StrFnd = "|": Options.DefaultHighlightColorIndex = wdYellow
With DocTgt.Tables(1)
  For i = 2 To .Rows.Count
    StrFnd = StrFnd & Split(.Rows(i).Cells(1).Range.Text, vbCr)(0) & "|"
  Next
End With
While strFile <> ""
  If strFolder & "\" & strFile <> strDocNm Then
    Set DocSrc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    With DocSrc
      With .Range.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Replacement.Text = "^&"
        .Replacement.Highlight = True
        .MatchWholeWord = True
        .MatchCase = False
        .Wrap = wdFindContinue
        'Process each word from the StrFnd List
        For i = 1 To UBound(Split(StrFnd, "|"))
          .Text = Split(StrFnd, "|")(i)
          .Execute Replace:=wdReplaceAll
          If .Found = True Then
            StrOut = StrOut & Split(StrFnd, "|")(i) & " found in " & strFile & Chr(11)
          End If
        Next
      End With
      .Close True
    End With
  End If
  DoEvents
  strFile = Dir()
Wend
DocTgt.Range.InsertAfter StrOut
Set DocSrc = Nothing: Set DocTgt = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

按照编码，宏假定输出将被发送到它正在运行的文档，并且关键字列表位于该文档中第一个表的第一列，从第2行开始。代码包含一个文件夹浏览器，所以你需要做的就是选择要处理的文件夹。我保留了你的突出显示规格，虽然我看不出有它们的意义，因为你的代码在删除文件之前删除了文件中找到的内容。我的实现突出显示了源文件中找到的内容。如果您不想这样做，您也可以删除：

：Options.DefaultHighlightColorIndex = wdYellow

.Replacement.Highlight = True

.Replacement.Text =“^＆amp;”

和

取代：= wdReplaceAll

以及改变：

。关闭True

为：

。关闭错误

无论您采用哪种方式，上述代码都应该比您现在使用的代码更有效。

Answer 2

请参阅我对您的方法的评论。至于问题本身，改变：

.Wrap = wdFindContinue

为：

.Wrap = wdFindStop

PS：即使你现在的方法，所有：

PageCount = ActiveDocument.ComputeStatistics(wdStatisticPages)
ActiveDocument.Select
Set DocRange = Selection.Range
Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=2
DocRange.Start = Selection.Bookmarks("\Page").Range.Start
Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=PageCount
DocRange.End = Selection.Bookmarks("\Page").Range.End

可以替换为：

Set DocRange = ActiveDocument.Range(0, 0)
Set DocRange = DocRange.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=2)
Set DocRange = DocRange.GoTo(What:=wdGoToBookmark, Name:="\page")
DocRange.End = ActiveDocument.Range.End

在VBA中搜索Word文档的特定选择

2 个答案: