2011-04-13 100 views
1

我有一个代码,下面已经工作。不过,我需要进一步简化代码。我下面的代码计算文档中出现的单词。代码如下:WORD VBA计数字发生

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 
+0

的可能的复制[在VBA字匹配的字符串如何加快(http://stackoverflow.com/questions/33637862/word -occurances功能于VBA - 如何对加速) – 2015-11-10 20:28:42

回答

0

我会认为是“简化”你的意思是“提高性能”,我怀疑这将是缓慢的窘况。

我会避免通过使用查找所有单词。相反的:

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

我认为你应该使用:

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