Question

此宏通过Word文档搜索单词：Set r = WordDoc.Range。是否可以仅在Word文档中的特定单词之间进行搜索？示例：仅从“Word1”搜索“Word2”。我知道我需要找到这些单词并将它们设置为Range.Start和Range.End，但我并不擅长这个。有人可以用代码帮助我吗？

Sub test()
Dim Word As Object, WordDoc  As Object
Dim r As Boolean, f As Boolean, fO As Long
Set Word = CreateObject("Word.Application")
Set WordDoc = Word.Documents.Open(Filename:=Application.ThisWorkbook.path & "\test.docx")

'''name'''
Set r = WordDoc.Range
Do While UnifiedSearch(r, "name*book1")
    If f Then
        If r.Start = fO Then
            Exit Do
        End If
    Else
        fO = r.Start
        f = True
    End If
    WordDoc.Range(r.Start + 4, r.End - 5).Copy
    Range("C4").Select
    ActiveSheet.Paste
    Set r = WordDoc.Range(r.End, r.End)
Loop

WordDoc.Close
Word.Quit

End Sub

Private Function UnifiedSearch(r As Range, s As String) As Boolean

     With r.Find
        .ClearFormatting
        .Text = s
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        UnifiedSearch = .Execute
    End With

End Function

Answer 1

我不清楚你的所有代码应该做什么，但我改变了第一部分来搜索这两个术语，然后将搜索范围设置为两个术语之间的所有内容（包括术语，本身）。我使用了多个范围，以便始终清楚Range指的是哪个内容。

我必须对您的代码进行一些更正，例如，当它应该是Word.Range时，您将Object声明为布尔值。我还必须更改Word应用程序的对象，因为需要使用Word.Range声明Range以区分Excel范围。或者，如果未设置对Word对象库的引用，则需要将这些声明更改为Duplicate。

注意如何使用Sub test() Dim wd As Object, WordDoc As Object Dim r As Word.Range, f As Boolean, fO As Long Dim rStart As Word.Range, rEnd As Word.Range, rSearch As Word.Range Set wd = CreateObject("Word.Application") Set WordDoc = wd.Documents.Open(Filename:=Application.ThisWorkbook.path & "\test.docx") '''name''' Set r = WordDoc.content Set rStart = r.Duplicate If Not UnifiedSearch(rStart, "Word 1") Then Exit Sub End If Set rEnd = rStart.Duplicate rEnd.End = r.End If Not UnifiedSearch(rEnd, "Word 2") Then Exit Sub End If Set rSearch = r.Duplicate rSearch.Start = rStart.Start rSearch.End = rEnd.End Do While UnifiedSearch(rSearch, "name*book1") If f Then If r.Start = fO Then Exit Do End If Else fO = r.Start f = True End If WordDoc.Range(r.Start + 4, r.End - 5).Copy Range("C4").Select ActiveSheet.Paste Set r = WordDoc.Range(r.End, r.End) Loop ' WordDoc.Close Set WordDoc = Nothing wd.Quit Set wd = Nothing End Sub Private Function UnifiedSearch(ByRef r As Range, s As String) As Boolean Dim found As Boolean With r.Find .ClearFormatting .Text = s .Forward = True .wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True found = .Execute End With Debug.Print found, s UnifiedSearch = found End Function属性来将Range“复制”到独立的Range对象。

GROUP BY

在Word文档中的特定单词之间搜索

1 个答案: