通過格式化宏有效字數

Question

我有一個單詞宏，用於統計文檔中突出顯示或未加下劃線粗體的所有文本。宏工作正常 - 雖然計數略高於「查找」功能在某些文檔上返回的結果（如果有人知道爲什麼我會很高興地發現它）。

宏的問題在於，它的效率非常低，並且在長度大約爲50頁的文檔上運行時滯留在計算機上的時間並不是很多。有沒有人看到更有效的方式來編寫類似功能的宏？

Dim highlightCount 
    Dim boldCount 
    Dim wordTotal 
    boldCount = 0 
    highlightCount = 0 

    For Each w In ActiveDocument.Words 
     If w.HighlightColorIndex <> wdNoHighlight Then 
      highlightCount = highlightCount + 1 
     End If 
     If w.Font.Bold = True Then 
      If w.HighlightColorIndex = wdNoHighlight Then 
       If w.Font.Underline = False Then 
        boldCount = boldCount + 1 
       End If 
      End If 
     End If 
    Next 
    wordTotal = highlightCount + boldCount 
    MsgBox ("There are " & wordTotal & " words to be spread") 
End Sub 

Answer 1

我無法回答您關於計數器結果太高的問題，因爲我在代碼中看不到問題。但我可以提出另一種解決方案，我使用Find對象，我猜這會比你的想法快得多。唯一的問題是，對於你定義的兩種類型的單詞條件，你必須單獨運行兩次「搜索」（下面兩個循環）。

Sub CountWords() 

Dim rngWords As Range 
Set rngWords = ActiveDocument.Content 
Dim boldCount As Long, highlightCount As Long 
Dim wordTotal As Long 

Do 
With rngWords.Find 
    .Highlight = True 
    .Forward = True 
    .Execute 
End With 
If rngWords.Find.Found = True Then 
    highlightCount = highlightCount + rngWords.Words.Count 
Else 
    Exit Do 
End If 
Loop 

Set rngWords = ActiveDocument.Content 

Do 
With rngWords.Find 
    .Font.Bold = True 
    .Highlight = False 
    .Font.Underline = wdUnderlineNone 
    .Forward = True 
    .Execute 
End With 
If rngWords.Find.Found = True Then 
    boldCount = boldCount + rngWords.Words.Count 
Else 
    Exit Do 
End If 
Loop 

wordTotal = boldCount + highlightCount 
MsgBox "There are " & wordTotal & " words to be spread" 
End Sub 

如果因爲我沒有50頁文件進行測試，速度會更快，請問您能否給我們提供一些線索。