谁解女人心电视剧全集:利用“宏”打造Word高级字数统计功能

       利用“宏”打造Word高级字数统计功能 Word本身提供了强大的字数统计功能。以Word XP为例，选择菜单“工具”→“字数统计”，Word会显示出页数、字数、段落数、行数等信息，足以满足大多数用户的需要。尽管如此，有时候还是不免出现鞭长莫及的情形。

一、单个词语的出现次数
有一次一位朋友问我：Word能不能统计出特定关键词（例如某个人的姓名）的出现次数？我只能告诉他Word本身不直接支持这方面的文档分析功能。但是，我们可以另辟蹊径，用“查找/替换”功能得到某个词语的出现次数。步骤如下：
⑴ 按Ctrl+H显示出“查找和替换”对话框的“替换”页。
⑵ 在“查找内容”栏，输入要统计其出现次数的词语。
⑶ 在“替换为”栏，输入“^&”，表示要替换的内容就是查找的内容。这样，执行替换操作后文档的内容实际上不会改变。
⑷ 点击“全部替换”按钮。
⑸ Word执行替换，然后显示出有多少个词语被替换，如图一。这个数字就是该词语在文档中出现的次数。

图一

如果只是偶尔要了解一二个词语的出现次数，上面的办法足以应付。但是，如果经常要进行这类统计，最好用一个Word宏简化操作。下面的Word宏FindWords()首先提示用户要统计的单词，然后显示出该单词在文档中出现的次数；只要用户不点击“取消”按钮（或在不输入单词的情况下点击“确定”按钮），它将一直重复这个过程。
Sub FindWords()
Dim sResponse As String '要统计的单词
Dim iCount As Integer '出现次数
'反复询问要统计的单词，直至用户点击“取消”按钮
Do
' 获得想要统计其出现次数的单词
sResponse = InputBox(Prompt:="你想要统计什么单词？", _
Title:="统计单词出现次数", Default:="")
If sResponse > "" Then
' 每次统计之前，先将计数器清零
iCount = 0
Application.ScreenUpdating = False
With Selection
.HomeKey Unit:=wdStory
With .Find
.ClearFormatting
.Text = sResponse
' 扫描整个文档，统计指定单词的出现次数
Do While .Execute
iCount = iCount + 1
Selection.MoveRight
Loop
End With
' 显示出统计结果
MsgBox "单词“" & sResponse & "”" & " 共出现 " & iCount & " 次"
End With
Application.ScreenUpdating = True
End If
Loop While sResponse <> ""
End Sub
创建该Word宏的步骤是：
◆ 选择菜单“工具”→“宏”→“宏”，在“宏名”栏输入FindWords，点击“创建”按钮，Word打开Visual Basic宏编辑器。
◆ 在宏编辑器中输入FindWords宏的代码，如图二（图中只显示出一部分代码）。

图二

◆ 点击宏编辑器工具栏上的“保存”按钮，再选择菜单“文件”→“关闭并返回到Microsoft Word”，返回Word。
以后，只要运行FindWords宏，FindWords宏就会提示要统计的单词（图三），然后报告该单词的出现次数（图四）。为方便计，你可以为这个宏定义快捷键和工具栏图标，操作步骤如下：

图三

图四

◆ 选择Word菜单“工具”→“自定义”。
◆ 在对话框中选择“命令”选项卡。
◆ 在“类别”列表中选择“宏”，在“命令”列表中选择FindWords宏，如图五所示。

图五

◆ 按住鼠标左键，将FindWords拖到工具栏的适当位置，放开鼠标键。
◆ 工具栏上出现了代表FindWords的按钮。右击这个按钮，为它指定适当的名称和图标，如图六。

图六

◆ 关闭“自定义”对话框。
如果要为FindWords宏定义快捷键，只需在图五的“自定义”对话框中点击“键盘”，然后根据提示操作即可。
二、分析用词习惯
不同的人有不同的写作习惯，我曾经看到一则新闻，具体情节已经忘记，大致如此：有一本小说S，因年代久远，人们无法判断它到底是作家A写的还是B写的。于是科学家想了一个办法：首先分析A和B各自的写作习惯，然后将它与S的写作风格对比，以此判断S的真正作者。所谓分析A和B的写作习惯，就是针对肯定是A或B写的小说，分析其各个单词的出现频度，只要统计资料足够多，每个人的作品会呈现出各自鲜明的特征。
其实在Word中，我们也可以方便地实现统计各个单词出现频度的功能，如WordFrequency宏所示。
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