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页的测试文件，你能不能给我们提供一个线索。

通过格式化宏来实现高效的字数统计

1 个答案: