在Excel中，我們經常需要分析文本數據，例如統計某個單詞或短語在文檔中出現的次數。雖然Excel本身提供了一些文本處理功能（如COUNTIF），但對于復雜的詞頻統計，手動操作可能效率低下。這時，VBA宏可以自動化這一過程，快速生成詞頻統計表。
實現方法
-
準備數據
- 確保待分析的文本位于Excel的某一列（如A列）。
- 在另一列（如B列）列出需要統計的目標單詞或短語。
-
編寫VBA宏
- 打開VBA編輯器（
Alt + F11），插入新模塊。 - 使用
For Each循環遍歷目標詞列表，并利用InStr或Split函數計算每個詞在文本中的出現次數。 - 將統計結果輸出到指定列（如C列）。
- 打開VBA編輯器（
-
優化與擴展
- 可調整宏以支持不區分大小寫的匹配（使用
LCase函數）。 - 若需統計多個文本區域，可擴展宏以遍歷多個工作表或工作簿。
- 可調整宏以支持不區分大小寫的匹配（使用
一、宏功能概述
這段VBA代碼用于在Excel中統計單詞或短語的出現頻率，支持統計1個單詞、2個單詞組合或3個單詞組合的出現次數。
二、準備工作
'1. 添加引用："Microsoft VBScript Regular Expressions 5.5"
' 在VBA編輯器中：工具 -> 引用 -> 勾選"Microsoft VBScript Regular Expressions 5.5" -> 確定
'2. 數據必須放在A列，從A1開始
'3. 運行Word_Phrase_Frequency_v1宏
三、關鍵參數設置
'--- 修改以下參數以適應你的需求 -----------------------------------Const sNumber As String = "1,2,3" '"1,2,3"
'sNumber = "1" 只統計單個單詞頻率
'sNumber = "1,2,3" 統計1個、2個和3個單詞組合的頻率Const xPattern As String = "A-Z0-9_'"
'定義單詞字符，上述模式將包含字母、數字、下劃線和撇號作為單詞字符
'例如："you're"會被視為一個單詞，"aa_bb"也會被視為一個單詞Const xCol As String = "C:ZZ" '要清空的列范圍
四、主程序解析
Sub Word_Phrase_Frequency_v1()Dim i As Long, j As LongDim txa As StringDim z, tt = Timer '記錄開始時間Application.ScreenUpdating = False '關閉屏幕更新以提高速度Range(xCol).Clear '清空指定列'清除A列中的錯誤值On Error Resume NextRange("A:A").SpecialCells(xlCellTypeFormulas, xlErrors).ClearContentsRange("A:A").SpecialCells(xlConstants, xlErrors).ClearContentsOn Error GoTo 0'獲取A列最后一行行號j = Range("A" & Rows.Count).End(xlUp).Row'將A列內容合并為一個字符串If j < 65000 Thentxa = Join(Application.Transpose(Range("A1", Cells(Rows.Count, "A").End(xlUp))), " ")Else'如果數據超過65000行，分段處理For i = 1 To j Step 65000txa = txa & Join(Application.Transpose(Range("A" & i).Resize(65000)), " ") & " "NextEnd If'處理sNumber參數z = Split(sNumber, ",")'調用處理函數For i = LBound(z) To UBound(z)Call toProcessY(CLng(z(i)), txa, xPattern)Next'調整列寬，恢復屏幕更新Range(xCol).Columns.AutoFitApplication.ScreenUpdating = TrueDebug.Print "處理完成，耗時: " & Timer - t & " 秒"
End Sub
五、核心處理函數
Sub toProcessY(n As Long, ByVal tx As String, xP As String)'n: 要統計的單詞組合長度'tx: 待處理的文本'xP: 單詞字符模式Dim regEx As Object, matches As Object, x As Object, d As ObjectDim i As Long, rc As LongDim va, q'創建正則表達式對象Set regEx = CreateObject("VBScript.RegExp")With regEx.Global = True '全局匹配.MultiLine = True '多行模式.ignorecase = True '忽略大小寫End With'處理多單詞組合的情況If n > 1 Then'移除多余空格regEx.Pattern = "( ){2,}"If regEx.Test(tx) Thentx = regEx.Replace(tx, " ")End Iftx = Trim(tx) '去除首尾空格'替換非單詞字符（保留空格）regEx.Pattern = "[^" & xP & " ]+"If regEx.Test(tx) Thentx = regEx.Replace(tx, vbLf)End If'移除每行開頭的空格tx = Replace(tx, vbLf & " ", vbLf & "")End If'創建字典對象存儲詞頻Set d = CreateObject("scripting.dictionary")d.CompareMode = vbTextCompare '文本比較模式（不區分大小寫）'構建正則表達式模式匹配n個單詞的組合regEx.Pattern = Trim(WorksheetFunction.Rept("[" & xP & "]+ ", n))Set matches = regEx.Execute(tx)'統計詞頻For Each x In matchesd(CStr(x)) = d(CStr(x)) + 1Next'處理不同組合情況（針對n>1）For i = 1 To n - 1regEx.Pattern = "^[" & xP & "]+ "If regEx.Test(tx) Thentx = regEx.Replace(tx, "") '移除每行的第一個單詞regEx.Pattern = Trim(WorksheetFunction.Rept("[" & xP & "]+ ", n))Set matches = regEx.Execute(tx)For Each x In matchesd(CStr(x)) = d(CStr(x)) + 1NextEnd IfNext'如果沒有找到結果則退出If d.Count = 0 Then MsgBox "沒有找到 " & n & " 個單詞的組合": Exit Sub'確定輸出列rc = Cells(1, Columns.Count).End(xlToLeft).Column'輸出結果With Cells(2, rc + 2).Resize(d.Count, 2)Select Case d.CountCase Is < 65536 'Transpose函數限制65536個項目.Value = Application.Transpose(Array(d.Keys, d.Items))Case Is <= 1048500'大數據量處理ReDim va(1 To d.Count, 1 To 2)i = 0For Each q In d.Keysi = i + 1va(i, 1) = q: va(i, 2) = d(q)Next.Value = vaCase ElseMsgBox "處理取消，結果超過1048500行"End Select'排序：按詞頻降序，按單詞升序.Sort Key1:=.Cells(1, 2), Order1:=xlDescending, _Key2:=.Cells(1, 1), Order2:=xlAscending, Header:=xlNoEnd With'添加標題Cells(1, rc + 2) = n & " 單詞組合"Cells(1, rc + 3) = "出現次數"
End Sub
六、使用步驟
- 將待分析文本放入A列（從A1開始）
- 修改sNumber參數設置要統計的單詞組合長度
- 修改xPattern參數定義單詞字符（默認包含字母、數字、下劃線和撇號）
- 運行Word_Phrase_Frequency_v1宏
- 結果將輸出到右側空白列，包含單詞/短語和出現次數，并按頻率排序
七、注意事項
- 大數據量處理可能需要較長時間
- 結果最多支持1,048,500行
- 正則表達式模式可根據需要調整xPattern參數
- 如需統計中文，需要修改xPattern參數包含中文字符
