如何从指定的数组/列表中查找缺失的单词？

Question

我有一个需要验证的单词列表是否包含在数百个文档中。

我想出了如何从文档中找到的列表中突出显示/着色单词（下面的代码）。

我需要知道缺少哪些单词。

Sub HighlightWords()
    Dim vWords As Variant
    Dim sWord As Variant

    vWords = Array("SQL query", "Selenium", "Cucumber", "Rest-Assured", "Rest assured", "REST API", "TestNG", "SVN", "Subversion", "Maven", "IntelliJ", "Ecliipse", "Confluence", "JIRA", "Sauce Labs", "GitLab", "HTML", "XPATH", "CSS", "Object Oriented Programming", "Object-Orienting Programming", "OOP")

    For Each sWord In vWords
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        Selection.Find.Replacement.Highlight = wdYellow
        With Selection.Find
            .Text = sWord
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = False
            .MatchWholeWord = True
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    Next sWord
End Sub

Answer 1

以下代码将在消息框中显示缺少的术语。

Sub HighlightWords()
    Dim vWords As Variant
    Dim sWord As Variant
    Dim Missing As String

    vWords = Array("SQL query", "Selenium", "Cucumber", "Rest-Assured", "Rest assured", "REST API", "TestNG", "SVN", "Subversion", "Maven", "IntelliJ", "Ecliipse", "Confluence", "JIRA", "Sauce Labs", "GitLab", "HTML", "XPATH", "CSS", "Object Oriented Programming", "Object-Orienting Programming", "OOP")

    For Each sWord In vWords
        With ActiveDocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Replacement.Highlight = wdYellow
            .Text = sWord
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = False
            .MatchWholeWord = True
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            If Not .Execute(Replace:=wdReplaceAll) Then Missing = Missing & sWord & ", "
        End With
    Next sWord
    If Not Missing = vbNullString Then _
        MsgBox "Missing terms:" & vbCr & vbCr & Left(Missing, Len(Missing) - 2)
End Sub

Answer 2

下面将为您提供缺失单词作为集合或数组的列表：

Option Explicit

Public Sub FindMissingWords()
    Dim vWords() As Variant
    vWords = Array("SQL query", "Selenium", "Cucumber", "Rest-Assured", "Rest assured", "REST API", "TestNG", "SVN", "Subversion", "Maven", "IntelliJ", "Ecliipse", "Confluence", "JIRA", "Sauce Labs", "GitLab", "HTML", "XPATH", "CSS", "Object Oriented Programming", "Object-Orienting Programming", "OOP")
    
    Dim MissingWords As New Collection
    
    Dim sWord As Variant
    For Each sWord In vWords
        If Not IsKeywordInRange(sWord, ThisDocument.Range) Then
            MissingWords.Add sWord
        End If
    Next sWord
    
    If MissingWords.Count > 0 Then
        MsgBox "The following " & MissingWords.Count & " words are missing: " & Join(CollectionToArray(MissingWords), ", "), vbExclamation
    Else
        MsgBox "No words are missing.", vbInformation
    End If
End Sub

Public Function IsKeywordInRange(ByVal Keyword As String, ByVal InRange As Range) As Boolean
    'check if a keyword is in the range
    
    With InRange.Find
        .Text = Keyword
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    
    IsKeywordInRange = InRange.Find.Execute
End Function

Public Function CollectionToArray(ByVal Coll As Collection, Optional ByVal StartIdx As Long, Optional ByVal Size As Long) As Variant
    ' Convert a collection into an array
    
    Dim Arr() As Variant
    Dim Ci As Variant   ' Collection element
    Dim i As Long
    
    ' Make sure Size is not less than collection size
    If Size < Coll.Count Then Size = Coll.Count
    
    ' Transfer collection to array
    ReDim Arr(StartIdx To StartIdx + Size - 1)
    For Each Ci In Coll
        Arr(i) = Ci
        i = i + 1
    Next

    CollectionToArray = Arr
End Function

请注意，将文档中关键字是否存在的测试外包到函数中可以使您的代码更具可读性，并且更容易测试或重用。