風来坊日記-日中翻訳 このページをアンテナに追加 RSSフィード

2007-05-07word 詞頻統計 Macro

Sub 詞頻統計()

'

' 詞頻統計 Macro

' 作成日 2007-5-7 作成者 LEE tel:13972465693 qq:279584079

'

'

' WordFrenquency Macro

' 宏在 2004-04-20 由 王海波 创建

'

Dim SingleWord As String '从当前文档提取的一个单词

Const maxWords = 15000 '允许出现的不同单词的最大数量,如不够,可适当加大

Dim Words(maxWords) As String '用来保存各个不同的单词

Dim Freq(maxWords) As Integer '出现频度计数器

Dim WordNum As Integer '不同单词的数量

Dim ByFreq As Boolean '输出结果的排序标准

Dim ttlwds As Long '文档中的单词总数

Dim Excludes As String '不在统计范围内的单词

Dim Found As Boolean '临时标记

Dim j, k, l, Temp As Integer '临时变量

Dim tWord As String '

' 设置要排除的单词。

' 英文排除词:[the][a][of][is][to][for][this][that][by][be][and][are]

' 排除词可以从各大搜索引擎的说明获得,可根据实际情况修改

Excludes = "[ ][的][是]"

' 向用户询问排序标准

ByFreq = True

ans = InputBox$("根据单词(1)还是频度(2)排序?", "排序标准", "1")

If ans = "" Then End

If Trim(ans) = "1" Then

ByFreq = False

End If

'开始分析文档

Selection.HomeKey Unit:=wdStory

System.Cursor = wdCursorWait

WordNum = 0

ttlwds = ActiveDocument.Words.Count


' 处理文档中的每个单词

For Each aWord In ActiveDocument.Words

'英文单词不区分大小写

SingleWord = Trim(LCase(aWord))

'该单词是否在排除列表中?

If InStr(Excludes, "[" & SingleWord & "]") Then SingleWord = ""

If Len(SingleWord) > 0 Then

'找到一个需要处理的单词

Found = False

For j = 1 To WordNum

If Words(j) = SingleWord Then

' 这个单词已经出现过了

' 把它的出现频度加1

Freq(j) = Freq(j) + 1

Found = True

Exit For

End If

Next j

If Not Found Then

' 这个单词还没有出现过

' 将它登记为一个新的单词

' 出现频度设置为1

WordNum = WordNum + 1

Words(WordNum) = SingleWord

Freq(WordNum) = 1

End If

If WordNum > maxWords - 1 Then

j = MsgBox("已达到单词数量的最大限制值。请增加maxWords的值.", vbOKOnly)

Exit For

End If

End If

ttlwds = ttlwds - 1

'在状态栏上显示处理进度

StatusBar = "剩余:" & ttlwds & " 不同单词数量: " & WordNum

Next aWord

' 对处理结果进行排序

For j = 1 To WordNum - 1

k = j

For l = j + 1 To WordNum

If (Not ByFreq And Words(l) < Words(k)) Or (ByFreq And Freq(l) > Freq(k)) Then k = l

Next l

If k <> j Then

tWord = Words(j)

Words(j) = Words(k)

Words(k) = tWord

Temp = Freq(j)

Freq(j) = Freq(k)

Freq(k) = Temp

End If

'排序进度

StatusBar = "正在排序:" & WordNum - j

Next j

' 将统计结果显示到一个新的Word文档

tmpName = ActiveDocument.AttachedTemplate.FullName

' 创建一个新文档

Documents.Add Template:=tmpName, NewTemplate:=False

'清除...

Selection.ParagraphFormat.TabStops.ClearAll

' 将处理结果写入新文档,每个单词一行

With Selection

For j = 1 To WordNum

.TypeText Text:=Trim(Str(Freq(j))) & vbTab & Words(j) & vbCrLf

Next j

End With

System.Cursor = wdCursorNormal

j = MsgBox("该文档总共有" & Trim(Str(WordNum)) & "个不同的单词。", vbOKOnly, "分析完毕!")


End Sub

kong kong 2007/09/01 18:09 问问 我想学翻译 你的学校能吗

vjatkszzxpvjatkszzxp 2011/03/08 18:01 RYVL7e <a href="http://bvavduqjjjzn.com/">bvavduqjjjzn</a>, [url=http://hncnatllniqj.com/]hncnatllniqj[/url], [link=http://nyguconmxtqk.com/]nyguconmxtqk[/link], http://olamcqczqele.com/

KamalKamal 2013/01/07 11:01 What I find so interesting is you could never find this aynhwere else.

npxblnqrnpxblnqr 2013/01/08 01:32 tViRVn <a href="http://fwgsmtldkxpy.com/">fwgsmtldkxpy</a>

jpfmbutugnjpfmbutugn 2013/01/08 14:14 2ar4rM , [url=http://xzwzhrgmoflr.com/]xzwzhrgmoflr[/url], [link=http://jyhvfkzhynhb.com/]jyhvfkzhynhb[/link], http://fnmqdbmxqifs.com/

ゲスト



トラックバック - http://chinese.g.hatena.ne.jp/magiclee/20070507