内容提要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 - timeApplication.DisplayAlerts=True Application.ScreenUpdating = TrueEndSub代码解析：（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 FunctionFunction 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 FunctionFunction 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~~~~~~喜欢就点个赞、点在看、留言评论、分享一下呗感谢支持
（图片来源网络，侵删）
0 评论