ワード数VBAカウントワード出現数

Question

私は既に動作している以下のコードを持っています。しかし、私はさらにコードを簡素化する必要があります。私は以下のコードは、文書内の単語の出現を数えます。コードは次のとおりです。

Option Base 1 

Sub arrangepara() 
Dim r As Range 

Set r = activedocument.Range 
If (r.Characters.Last.text = vbCr) Then r.End = r.End - 1 
sortpara r 
End Sub 

Function sortpara(r As Range) 
Dim sWrd As String 
Dim Found As Boolean 
Dim N As Integer, i As Integer, j As Integer, k As Integer, WordNum As Integer 
N = r.Words.count 
ReDim Freq(N) As Integer 
ReDim Words(N) As String 
Dim temp As String 

i = 1 
WordNum = 0 
Do While r.Find.Execute(findtext:="<*>", MatchWildcards:=True, Wrap:=wdFindStop) = True 
    If i = N Then Exit Do 
     Found = False 
     For j = 1 To WordNum 
       If Words(j) = r.text Then 
        Freq(j) = Freq(j) + 1 
        Found = True 
        Exit For 
       End If 
     Next j 
     If Not Found Then 
      WordNum = WordNum + 1 
      Words(WordNum) = r.text 
      Freq(WordNum) = 1 
     End If 
    i = i + 1 
Loop 

Set r = activedocument.Range 
r.Collapse wdCollapseEnd 
r.InsertParagraphBefore 
r.Collapse wdCollapseEnd 

r.InsertAfter "Occurrence List:" 
r.Collapse wdCollapseEnd 
r.InsertParagraphBefore 
r.Collapse wdCollapseEnd 


For j = 1 To WordNum 
    r.InsertAfter Words(j) & " (" & Freq(j) & ")" & vbCr 
Next j 

r.Select 
Selection.sort SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending 
r.Font.Color = wdColorAqua 

End Function 

私はこの部分を単純にする必要があります。私のためのコードを簡素化することができる良いサマリタンがありますか？どうもありがとう！私は、これは恐ろしく遅いことになるだろう疑いがあるとして、あなたは「パフォーマンスを向上させる」という意味私は「簡素化」によってと仮定するつもりです

Do While r.Find.Execute(findtext:="<*>", MatchWildcards:=True, Wrap:=wdFindStop) = True 
    If i = N Then Exit Do 
     Found = False 
     For j = 1 To WordNum 
       If Words(j) = r.text Then 
        Freq(j) = Freq(j) + 1 
        Found = True 
        Exit For 
       End If 
     Next j 
     If Not Found Then 
      WordNum = WordNum + 1 
      Words(WordNum) = r.text 
      Freq(WordNum) = 1 
     End If 
    i = i + 1 
Loop 

Answer 1

：以下は、私は単純化するために必要なものです。

Findを使用してすべての単語を取得しないようにします。代わりに：

Do While r.Find.Execute(findtext:="<*>", MatchWildcards:=True, Wrap:=wdFindStop) = True 
    ... 
Loop 

私はあなたが使うべきだと思う：

Dim w as Word 
For each w In ActiveDocument.Words 
    ... 
Next