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
i have a code below that is already working. However i need to simplify the code even further. The code i have below counts the word occurrences in a document. The code is as follows:
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
I need to simply this part and i dont know how. Are there any good samaritans out there that can simplify the codes for me? Thanks much! Below is what i need to simplify:
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
如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。
绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱,如果其他用户或者作者回复了您的评论,将不能在第一时间通知您!
发布评论
评论(1)
我假设“简化”的意思是“提高性能”,因为我怀疑这会非常慢。
我会避免使用“查找”来获取所有单词。而不是:
我认为你应该使用:
I'm going to assume that by "simplify" you mean "improve performance", as I suspect this is going to be horrendously slow.
I would avoid getting all the words by using Find. Instead of:
I think you should use: