Sub詞頻統(tǒng)計(jì)()''詞頻統(tǒng)計(jì)Macro'DimSingleWordAsString'從當(dāng)前文檔提取的一個(gè)單詞ConstmaxWords=15000'允許出現(xiàn)的不同單詞的最大數(shù)量,如不夠,可適當(dāng)加大DimWords(maxWords)AsString'用來(lái)保存各個(gè)不同的單詞DimFreq(maxWords)AsInteger'出現(xiàn)頻度計(jì)數(shù)器DimWordNumAsInteger'不同單詞的數(shù)量DimByFreqAsBoolean'輸出結(jié)果的排序標(biāo)準(zhǔn)DimttlwdsAsLong'文檔中的單詞總數(shù)DimExcludesAsString'不在統(tǒng)計(jì)范圍內(nèi)的單詞DimFoundAsBoolean'臨時(shí)標(biāo)記Dimj,k,l,TempAsInteger'臨時(shí)變量DimtWordAsString''設(shè)置要排除的單詞。'英文排除詞:[the][a][of][is][to][for][this][that][by][be][and][are]'排除詞可以從各大搜索引擎的說(shuō)明獲得，可根據(jù)實(shí)際情況修改Excludes="[][的][是]"'向用戶詢問(wèn)排序標(biāo)準(zhǔn)ByFreq=Trueans=InputBox$("根據(jù)單詞(1)還是頻度(2)排序？","排序標(biāo)準(zhǔn)","1")Ifans=""ThenEndIfTrim(ans)="1"ThenByFreq=FalseEndIf'開(kāi)始分析文檔Selection.HomeKeyUnit:=wdStorySystem.Cursor=wdCursorWaitWordNum=0ttlwds=ActiveDocument.Words.Count'處理文檔中的每個(gè)單詞ForEachaWordInActiveDocument.Words'英文單詞不區(qū)分大小寫(xiě)SingleWord=Trim(LCase(aWord))'該單詞是否在排除列表中？IfInStr(Excludes,"["&SingleWord&"]")ThenSingleWord=""IfLen(SingleWord)>0Then'找到一個(gè)需要處理的單詞Found=FalseForj=1ToWordNumIfWords(j)=SingleWordThen'這個(gè)單詞已經(jīng)出現(xiàn)過(guò)了'把它的出現(xiàn)頻度加1Freq(j)=Freq(j)+1Found=TrueExitForEndIfNextjIfNotFoundThen'這個(gè)單詞還沒(méi)有出現(xiàn)過(guò)'將它登記為一個(gè)新的單詞'出現(xiàn)頻度設(shè)置為1WordNum=WordNum+1Words(WordNum)=SingleWordFreq(WordNum)=1EndIfIfWordNum>maxWords-1Thenj=MsgBox("已達(dá)到單詞數(shù)量的最大限制值。請(qǐng)?jiān)黾觤axWords的值.",vbOKOnly)ExitForEndIfEndIfttlwds=ttlwds-1'在狀態(tài)欄上顯示處理進(jìn)度StatusBar="剩余："&ttlwds&"不同單詞數(shù)量:"&WordNumNextaWord'對(duì)處理結(jié)果進(jìn)行排序Forj=1ToWordNum-1k=jForl=j+1ToWordNumIf(NotByFreqAndWords(l)<Words(k))Or(ByFreqAndFreq(l)>Freq(k))Thenk=lNextlIfk<>jThentWord=Words(j)Words(j)=Words(k)Words(k)=tWordTemp=Freq(j)Freq(j)=Freq(k)Freq(k)=TempEndIf'排序進(jìn)度StatusBar="正在排序："&WordNum-jNextj'將統(tǒng)計(jì)結(jié)果顯示到一個(gè)新的Word文檔tmpName=ActiveDocument.AttachedTemplate.FullName'創(chuàng)建一個(gè)新文檔Documents.AddTemplate:=tmpName,NewTemplate:=False'清除...Selection.ParagraphFormat.TabStops.ClearAll'將處理結(jié)果寫(xiě)入新文檔,每個(gè)單詞一行WithSelectionForj=1ToWordNum.TypeTextText:=Trim(Str(Freq(j)))&vbTab&Words(j)&vbCrLfNextjEndWithS