Excel VBA【案例分享】英语单词词频统计/Word文档英文单词统计

快速浏览

往期合集：【2023年3月】【2023年4月】【2023年5月】【2023年6月】【2023年7月】【2023年8月】

实用案例

|日期控件||简单的收发存|

|电子发票管理助手|

|电子发票登记系统(Access版)|

|Excel多种类型文件合并|

|Excel表格拆分神器|

|批量生成审计凭证抽查底稿|

|中医诊所收费系统(Excel版)|

|中医诊所收费系统(Access版)|

|收费管理系(Access改进版)|

收费使用项目

|财务管理系统||工资薪金和年终奖个税筹划|

内容提要

• Excel VBA 处理Word文档
• 英文单词统计

大家好，我是冷水泡茶，不知有没有人在学英语啊？有没有做过英文单词词频统计呢？就是看看某篇文章，或者是一本英文书，有多少词汇量，哪些单词用得比较多？

今天在电脑里发现一个多年以前从网上搜来的Word VBA代码，是用来统计Word文档中的英语单词词频的，统计结果也是输出到Word文档里。

我想啊，单词列表存到Excel文档中，是不是要更实用一点呢？排序、筛选都很方便。

说干就干，我们在Excel中读取Word文档，统计所有英语单词出现的次数，分享给大家：

基本思路：

1、选择一个需要统计单词词频的Word文档。

2、对Word文档的文本进行处理，把标点符号替换成空格。

3、逐个循环每一个单词，把它添加到字典，同时利用字典的item进行计数。

4、统计完毕，把字典的Keys、Items分别存入Excel文档，保存。

5、可以设置对单词词频列表进行排序，但这块功能没有做，手工排序也很方便（主要是时间来不及了

）。

VBA代码

1、在模块1里，WordsFrequency过程：

Sub WordsFrequency()    '*********************************************    '作者：冷水泡茶，微信公众号：Excel活学活用    '*********************************************    Dim WordApp As Object    Dim WordDoc As Object    Dim wdFile As String    Dim wb As Workbook    Dim ws As Worksheet    Dim savePath As String    Dim arr()    Dim dic As Object    Dim Words() As String    Dim Word As Variant    Dim Text As String    Dim totalWords As Long    Dim time As Single    time = Timer    Application.DisplayAlerts = False    Application.ScreenUpdating = False    Set dic = CreateObject("Scripting.Dictionary")    wdFile = FileSelected    If wdFile = "" Then        MsgBox "请正确选择Word文件！"        Exit Sub    End If    savePath = PathSelected    If savePath = "" Then        If Not wContinue("未选择保存路径，将保存在当前文件夹下！") Then Exit Sub        savePath = ThisWorkbook.Path    End If    '打开Word文档    Set WordApp = CreateObject("Word.Application")    WordApp.Visible = False ' 隐藏Word应用程序    Set WordDoc = WordApp.Documents.Open(wdFile)    Set wb = Workbooks.Add    Set ws = wb.Sheets(1)    '从Word文档中提取文本    Text = WordDoc.Range.Text    Text = Replace(Text, "-", "")    arr = Array(".", ",", "!", "?", ";", ":", "'", "\", "(", ")", "[", "]", _        "{", "}", "/", "\\", "|", "_", "*", "&", "%", "$", "#", "@", "+", _        "=", "<", ">", "~", "`", """", "—", "”", "“", "", Chr(10), Chr(13))    For i = LBound(arr) To UBound(arr)        Text = Replace(Text, arr(i), " ")    Next    '将文本分割成单词    Words = Split(Text, " ")    '统计词频    For Each Word In Words        Word = Trim(Word) ' 去掉单词前后的空格        If Len(Word) > 0 Then ' 确保单词非空            totalWords = totalWords + 1            dic(Word) = dic(Word) + 1        End If    Next    '在Excel中写入词频数据    ws.Cells(1, 1) = "Words"    ws.Cells(1, 2) = "Frequency"    ws.Range("A2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.keys)    ws.Range("B2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.items)    '保存Excel文件    wb.SaveAs savePath & "\" & "word_freq" & Format(Now, "YYYYMMDDhhmmss") & ".xlsx" ' 替换成你想保存的Excel文件路径    '关闭并释放对象    wb.Close    WordDoc.Close    Set ws = Nothing    Set wb = Nothing    Set WordDoc = Nothing    Set WordApp = Nothing    MsgBox "词频统计完成" & Chr(10) & "总字数：" & totalWords & Chr(10) & "单词数：" & dic.Count & Chr(10) _        & "共耗时：" & Timer - time Application.DisplayAlerts = True    Application.ScreenUpdating = TrueEnd Sub

代码解析：

（1）Line5~17，定义一批变量。

（2）line22~31，选择需要处理的Word文档以及统计结果文件保存路径。

（3）line33~37，打开Word文档，准备进行文本处理；创建一个新的Excel文档，用于存放统计结果。

（4）line39~46，处理文本，把连字符“-”替换为空，把标点符号替换为空格，这里把常见的符号放在一个数组里，循环替换，在实际操作过程中，可以根据需要添加。

（5）line48~56，把文本根据空格分列为一个字符串数组，循环这个数组，把单词添加到字典中去，并统计数量。

（6）line58~63，把字典的keys、items写入Excel工作表并保存。

2、在模块1里，几个自定义函数：

Function PathSelected()    With Application.FileDialog(msoFileDialogFolderPicker)     .InitialFileName = ThisWorkbook.Path     .Title = "请选择保存路径"        If .Show = -1 Then                       'FileDialog 对象的 Show 方法显示对话框            PathSelected = .SelectedItems(1)        Else            Exit Function        End If    End WithEnd Function
Function FileSelected() With Application.FileDialog(msoFileDialogFilePicker) .Title = "请选择Word文件"        .AllowMultiSelect = False     '单选择        .Filters.Clear        '清除文件过滤器         .Filters.Add "Word Files", "*.doc;*.docx;*.docm"  '设置文件过滤器           .Filters.Add "All Files", "*.*"        .InitialFileName = ThisWorkbook.Path & "\.xlsx"        If .Show = -1 Then    'FileDialog 对象的 Show 方法显示对话框，并且返回 -1或0。            FileSelected = .SelectedItems(1)        Else            Exit Function        End If   End WithEnd Function
Function wContinue(Msg) As Boolean    '确认继续函数    Dim Config As Long    Dim a As Long    Config = vbYesNo + vbDefaultButton2 + vbQuestion    Ans = MsgBox(Msg & Chr(10) & "是(Y)继续?" & Chr(10) _    & "否(N)返回！", Config, "请确认操作！")     wContinue = Ans = vbYesEnd Function

代码解析：这几个自定义函数我们多次使用过，基本是复制过来的，不再细说。

（1）Line1~11，选择保存文件夹自定义函数。

（2）line13~27，选择文件，获取完整文件路径自定义函数。

（3）line29~37，确认继续自定义函数。

动画演示

~~~~~~End~~~~~~

喜欢就点个赞、点在看、留言评论、分享一下呗！感谢支持！

需要示例文件的朋友请留意以下说明：

• 写文不易，分享免费，请关注、点赞、点在看、点广告、留言，如果不便走上面的“流程”，请打赏，万分感谢！