2

強調表示されているか、下線が付いていない太字のドキュメント内のすべてのテキストをカウントする単語マクロがあります。マクロは正常に機能しますが、カウントは一部のドキュメントで「検索」機能が返すものよりもわずかに多くなります（誰かがそれを理解することに興奮する理由を知っている場合）。

マクロの問題は、マクロが非常に非効率的であり、長さが約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
4

1 に答える 1

2

コード内に問題が見当たらないため、カウンターの結果が高すぎるという質問には答えられません。しかし、私はFindあなたのアイデアよりもはるかに速いと思うオブジェクトを使用した別の解決策を提案することができます。唯一の問題は、定義した両方のタイプの単語条件に対して、「検索」を2回別々に実行する必要があることです（以下の2つのループ）。

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ページのドキュメントがないので、もっと速いかどうかの手がかりを教えてください。

于 2013-03-16T07:15:46.727 に答える