实例需求：产品清单如A列所示，现在如下统计多单词组合词组词频。

在上一篇博客中《使用VBA快速统计词组词频(多单词组合)（1/2）》讲解了如何实现双词的词频统计。

本文将讲解如何实现3词的词频统计，掌握实现方法之后，可以很容易地将代码扩展到实现更多单词词频统计，实现的效果如下图所示。

Sub Count3Words()Dim oDic1 As Object, oDic2 As Object, oDic3 As ObjectDim aProd, vProd, aWord, vWord, vKey, arrDataDim i As Long, sKey As StringSet oDic1 = CreateObject("scripting.dictionary") ' product list by ONE wordSet oDic2 = CreateObject("scripting.dictionary") ' product list by TWO wordsSet oDic3 = CreateObject("scripting.dictionary") ' product list by THREE wordsarrData = Range("A1").CurrentRegion.ValueFor i = LBound(arrData) + 1 To UBound(arrData)aWord = Split(arrData(i, 1))If UBound(aWord) > 1 ThenFor Each vWord In aWordIf oDic1.exists(vWord) ThenoDic1(vWord) = oDic1(vWord) & "," & arrData(i, 1)ElseoDic1(vWord) = arrData(i, 1)End IfNextEnd IfNext iFor Each vKey In oDic1.keysaProd = Split(oDic1(vKey), ",")For Each vProd In aProdaWord = Split(vProd)For Each vWord In aWordIf vWord <> vKey ThensKey = SortWord(vKey & " " & vWord)If oDic2.exists(sKey) ThenIf InStr(1, oDic2(sKey), vProd, vbTextCompare) = 0 ThenoDic2(sKey) = oDic2(sKey) & "," & vProdEnd IfElseoDic2(sKey) = vProdEnd IfEnd IfNextNextNextFor Each vKey In oDic2.keysaProd = Split(oDic2(vKey), ",")For Each vProd In aProdaWord = Split(vProd)For Each vWord In aWordIf InStr(1, vKey, vWord, vbTextCompare) = 0 ThensKey = SortWord(vKey & " " & vWord)If oDic3.exists(sKey) ThenIf InStr(1, oDic3(sKey), vProd, vbTextCompare) = 0 ThenoDic3(sKey) = oDic3(sKey) & "," & vProdEnd IfElseoDic3(sKey) = vProdEnd IfEnd IfNextNextNextFor Each vKey In oDic3.keysoDic3(vKey) = UBound(Split(oDic3(vKey), ",")) + 1NextRange("D:E").ClearRange("D1:E1").Value = Array("Word Pair", "Times")Range("D2").Resize(oDic3.Count, 1) = Application.Transpose(oDic3.keys)Range("E2").Resize(oDic3.Count, 1) = Application.Transpose(oDic3.items)
End Sub
Function SortWord(ByVal sText As String) As StringDim i As Long, j As Long, aWord, sTmp As StringaWord = Split(sText)If UBound(aWord) = 0 ThenSortWord = sTextElseFor i = LBound(aWord) To UBound(aWord) - 1For j = i + 1 To UBound(aWord)If aWord(i) > aWord(j) ThensTmp = aWord(i): aWord(i) = aWord(j): aWord(j) = sTmpEnd IfNextNextSortWord = Join(aWord)End If
End Function

【代码解析】
对于代码中和 上一篇博客 相同的部分，此处就不做赘述。
第9~20行代码将根据每个单词（产品名称拆分）合并产品名称清单，保存在oDic1。
第21~38行代码将根据双词合并产品名称清单，保存在oDic2。

此处实现逻辑比双词要更复杂，例如：对于两个单词sWord1和sWord2，只有如下两种两种组合方式：

• sWord1 sWord2
• sWord2 sWord1

但是对于3个单词sWord1、sWord2和sWord3，有如下6种组合方式，但是这些组合包含的单词相同的，其词频统计的结果也是相同的，为了避免统计结果中的重复，需要对于单词组合进行排序，也就是说使用排序后的单词组合作为字典对象的键，确保单词组合的唯一性，如果使用升序排列，那么将采用第一种组合方法作为键。其中排序由自定义函数SortWord实现。

• sWord1 sWord2 sWord3
• sWord1 sWord3 sWord3
• sWord2 sWord1 sWord3
• sWord2 sWord3 sWord1
• sWord3 sWord1 sWord2
• sWord3 sWord2 sWord1

第39~56行代码将根据3词合并产品名称清单，保存在oDic3。
第44行代码判断单词是否存在与vKey中，避免3个单词组合中出现重复的单词。
第45行代码调用自定义函数将3个单词进行排序生成字典的键。
第46~52行代码更新oDic3中的键值对。
第57~59行代码根据字典对象中产品名称清单，统计3词组合的词频。
第60~63行代码将统计结果输出到工作表中。

第65~80行代码为自定义函数SortWord。
第67行代码使用空格作为分隔符将参数sText拆分为数组。
如果拆分后数组只有单个元素，说明sText不包含空格，那么无需进行排序，第68行代码将sText设置为函数返回值。
第71~77行代码使用冒泡法进行排序。
第74行代码实现数据组元素交换。
第78行代码将排序的数组元素合并为一个字符串。