Question

我正在尝试编写一个宏，它将根据当前活动文档中的清单（您将在名为checklist的代码中看到它）查找文本。我已经将代码片段粘贴在一起，以便在下面找到宏。我的问题在于计算。我试图找出宏强调了多少次。稍后，此计数将与类别结合使用，以计算特定类别中突出显示的对象的数量（希望如此！）。我不得不承认，我只能模糊地遵循这段代码的实际操作，因为我是VBA的新手。任何帮助将非常感激。我所有获得准确计数的尝试都失败了。

要添加到此，有没有人知道计算多个列表的方法？说，我有几个字苹果和橙子属于水果单，芹菜和西兰花属于蔬菜列表。每次使用Apple（或橙色）时，它都会增加一个水果计数。蔬菜也是如此。然后，我希望将此数据导出到Excel工作表。我知道这听起来很复杂。对不起。再次感谢任何帮助。

Sub CompareWordList()

'This macro will find all of the words or phrases in the checklist document (to be developed) and highlight them.
'Further to this, the macro will provide a word count which is to be added to certain assessment criteria
'which will be provided by ___ once the development of this macro is complete.

Dim sCheckDoc As String
Dim docRef As Document
Dim docCurrent As Document
Dim wrdRef As Object
Dim count As Integer

sCheckDoc = "C:\Users\Nathaniel\Documents\checklist.docx"
Set docCurrent = Selection.Document
Set docRef = Documents.Open(sCheckDoc)
Set Range = ActiveDocument.Range

Application.ScreenUpdating = False

docCurrent.Activate
Options.DefaultHighlightColorIndex = wdYellow

count = 0

With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    '.Replacement.Font.Bold = True
    .Replacement.Highlight = True
    .Replacement.Text = "^&"
    .Forward = True
    .Format = True
    .MatchWholeWord = True
    .MatchCase = False
    .MatchWildcards = False

' I TRIED HERE* count = count +1
End With


    For Each wrdRef In docRef.Words
    If Asc(Left(wrdRef, 1)) > 32 Then
        With Selection.Find
            .Wrap = wdFindContinue
            .Text = wrdRef
            .MatchCase = False
            .Execute Replace:=wdReplaceAll

        End With

    End If
     'and here *count = count + 1
Next wrdRef

count = count + 1


 If count <> 0 Then

    MsgBox _
    count & " item(s) highlighted "

    Else
        MsgBox "Nothing was not found in the document/selection matching the checklist"
End If


docRef.Close
docCurrent.Activate

Application.ScreenUpdating = True

End Sub

Answer 1

您可以使用RegEx确定可能的替换次数。将文档的全部内容分配给字符串，然后计算RegEx匹配的数量。像这样的东西会起作用

Sub CountReplacements() ' Make sure you add a reference to Microsoft VBScript Regular Expressions 5.5
    Dim rex As New RegExp
    rex.Pattern = "[0-9]" ' Change RegEx pattern to whatever works for you
    rex.Global = True
    Dim str As String: str = ActiveDocument.Content
    Debug.Print Rex.Execute(str).Count
End Sub

在MS Word宏中查找，突出显示和计算单词列表（或字符串）

1 个答案: