word字数统计

word字数统计word字数统计 Sub WordFrequency() 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 ...

word字数统计 Sub WordFrequency() 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

                    本文档为【word字数统计】，请使用软件OFFICE或WPS软件打开。作品中的文字与图均可以修改和编辑，
                    图片更改请在作品中右键图片并更换，文字修改请直接点击文字进行修改，也可以新增和删除文档中的内容。 
 该文档来自用户分享，如有侵权行为请发邮件ishare@vip.sina.com联系网站客服，我们会及时删除。

                    [版权声明] 本站所有资料为用户分享产生，若发现您的权利被侵害，请联系客服邮件isharekefu@iask.cn，我们尽快处理。

                    本作品所展示的图片、画像、字体、音乐的版权可能需版权方额外授权，请谨慎使用。

                    网站提供的党政主题相关内容(国旗、国徽、党徽..)目的在于配合国家政策宣传，仅限个人学习分享使用，禁止用于任何广告和商用目的。
                

下载需要：免费已有0 人下载

立即下载

word字数统计

你可能还喜欢