☰

统计 Excel 中所有单词的出现次数

tag-icon • tag-icon microsoft-excel
统计 Excel 中所有单词的出现次数

所以我有一张包含一堆长度不一的文本字符串的 Excel 表。

我需要做的是在文档的 sheet2 上找到每个不同单词的实例。我可以使用 countif，但我必须为每个不同的单词（50-70 个不同的单词）创建一个不同的实例。或者使用 substitute/LEN 函数，因为它们是不同的文本。我真的不喜欢对每个单词都这样做。

有没有办法让 Excel 将文档中每个单词的单词和单词实例数打印到文档的第二张纸上？

答案1

根据您的 Excel 版本，可以使用第二张工作表上的三个公式来完成此操作。

第一公式

=FILTERXML("<t><s>" & SUBSTITUTE(TEXTJOIN("</s><s>",TRUE,Sheet1!1:1048576)," ","</s><s>") & "</s></t>", "//s")

将其替换Sheet1为您的工作表实际名称。如果它包含空格，则可能需要将其括在单引号中，例如'First Sheet'。

  • TEXTJOIN("</s><s>",TRUE,Sheet1!1:1048576)将整个工作表中的所有单元格合并为一个巨大的字符串。如果这不是您想要的，您可以将范围限制为您真正关心的任何单元格。文本用 分隔，</s><s>一分钟后会更有意义。（参考）
  • SUBSTITUTE(TEXTJOIN(~)," ","</s><s>")将用我们之前使用的空格替换文本中的所有空格</s><s>。现在，您有整个工作表中每个单元格的每个单词的列表。如果您还有用逗号、分号或句号分隔的单词，则可以添加其他SUBSTITUTE()函数来替换所有这些单词。（参考）
  • FILTERXML("<t><s>" & SUBSTITUTE(~) & "</s></t>", "//s")才是真正的魔法发生的地方。该函数并非专门为此目的而设计的，但您可以使用它将分隔字符串转换为数组。这使我们能够将字符串拆分为单个单元格。所有 XML 标签（如和）<t>都是<s>为了使字符串看起来像 XML。这就是我们</s><s>之前使用的原因。（参考）

第二个公式

=SORT(UNIQUE(A2#))

A2将第一个公式所在的位置替换为。

  • UNIQUE(~)将从列表中过滤掉重复的项目。(参考）
  • Sort(Unique(~))将对唯一单词列表进行排序。这不是必需的，但这样做很好。（参考）
  • 这里另一个有趣的地方是A2#（A2第一个公式在哪里）。#末尾的 告诉 Excel 将公式溢出到以 开始的列表末尾A2。当您从 中添加/删除单词时Sheet1，第一个公式返回的列表的大小将发生变化。在第二个公式中有这个动态引用意味着它将还更改大小以匹配。您可以判断公式何时溢出，因为当您选择其中的某个单元格时，该范围将具有蓝色边框。

第三公式

=COUNTIF(A2#,B2#)

A2将第一个公式所在的位置替换为，B2将第二个公式所在的位置替换为。

这个公式很多更简单。它所做的就是在整个单词列表中搜索每个唯一单词。同样，它#告诉它从每个单词的第一个单元格开始考虑整个列表。

结果

你可以把这个变成：

前

变成这样：

后

答案2

我找到了一个不错的 虚拟专用网络 帖子中的宏 有没有办法（公式或 vba 解决方案）来创建一列中所有单词的列表以及数字。

帖子的最后一条包含一个 VBA 函数，该函数创建一个名为“唯一词”的新工作表，并在其中返回所有唯一词及其出现次数。它假设数据位于活动工作表的 A 列中，因此需要根据您的情况进行修改。我已经测试过它，它工作正常。

要在电子表格中使用 VBA，必须将其另存为.xlsm（而不是.xlsx）。
您还必须 显示“开发工具”选项卡。

一切准备就绪后执行以下操作：

  • 要打开 VBA 编辑器，请按 Alt+F11
  • 在“插入”菜单中选择“模块”；编辑器应该打开
  • 复制并粘贴以下代码
  • 按 Alt+Q 返回 Excel
  • 在开发人员窗格中，单击“宏”，选择新的宏，最后单击“运行”。

这是功能代码：

'---------------------------------------------------------------------------------------
' Module    : CountUniqueWordsInRange
' Author    : JoeMo
' Date      : 3/28/2013
' Purpose   : Run from the activesheet. Assumes all data are in column A of the activesheet.
'             Requires that words are separated by the space character.
'             Returns all unique words with a count of the number of occurrences of
'             each word in column A to a new sheet named "Unique Words".
'             Limit on total word count that can be handled
'             is 17,179,869,184 (Excel 2007 or later versions). Limit on number of
'             unique words that can be handled is 1,048,575 (Excel 2007 or later versions).
'             Treats numbers and acronyms as words.
'---------------------------------------------------------------------------------------

Sub CountUniqueWordsInRange()
Dim rS As Range, sSht As Worksheet, dSht As Worksheet, aSht As Worksheet
Dim Punc As Variant, lRs As Long, lRd As Long, c As Range
Dim totWords As Long, colCt As Long, vA As Variant, vO() As Variant
Dim i As Long, j As Long, k As Long, Ct As Long, n As Long
'define source range
Set sSht = ActiveSheet
lRs = sSht.Range("A" & Rows.Count).End(xlUp).Row
Set rS = sSht.Range("A1", "A" & lRs)
'Get total word count
totWords = CountWords(rS)
'determine how many columns needed to list all words
colCt = WorksheetFunction.RoundUp(totWords / Rows.Count, 0)
If colCt > Columns.Count Then
    MsgBox "Too many words to list in one sheet - truncate the input range and try again." & vbNewLine & "Goodbye."
    Exit Sub
End If
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.DisplayAlerts = False
.StatusBar = "PROCESSING YOUR DATA - PLEASE BE PATIENT"
End With
'Add sheet to list all words in source range
On Error Resume Next
Worksheets("All Words").Delete
On Error GoTo 0
ActiveWorkbook.Sheets.Add after:=sSht
Set aSht = ActiveSheet
aSht.Name = "All Words"
'list all words
Punc = Array(".", ",", ";", ":", "?", "!", "~", "@", "#", "$", _
    "(", ")", "/", Chr(34), Chr(147), Chr(148))
For Each c In rS
    If Not IsEmpty(c) Then
        vA = Split(Trim(c.Value), " ")
        Ct = Ct + UBound(vA) + 1
        ReDim Preserve vO(1 To Ct)
        For i = LBound(vA) To UBound(vA)
            For j = LBound(Punc) To UBound(Punc)
                vA(i) = Replace(vA(i), Punc(j), "")
            Next j
        Next i
        For j = LBound(vA) To UBound(vA)
            k = k + 1
            vO(k) = vA(j)
        Next j
    End If
Next c
'put all words into All Words sheet
k = 0
n = 0
For i = 1 To colCt
    Do Until n = aSht.Rows.Count Or k = UBound(vO)
        k = k + 1
        n = n + 1
        aSht.Cells(n, i).Value = vO(k)
    Loop
    n = 0
Next i
'copy all words to sheet "Unique Words" and remove duplicates
On Error Resume Next
Worksheets("Unique Words").Delete
On Error GoTo 0
aSht.Copy after:=sSht
Set dSht = ActiveSheet
dSht.Name = "Unique Words"
For i = 1 To colCt
    dSht.Range("A1").CurrentRegion.Columns(i).RemoveDuplicates Columns:=1, Header:=xlNo
Next i
'Get word count remaining after dups removal from individual columns
totWords = CountWords(dSht.Range("A1").CurrentRegion)
If totWords > dSht.Rows.Count Then
    MsgBox "Too many words remaining for a single column after first pass - Goodbye."
    Exit Sub
End If
'Consolidate columns and remove dups again
With dSht
    lRd = .Range("A" & Rows.Count).End(xlUp).Row + 1
    For i = 2 To colCt
        .Range(Cells(1, i), Cells(Rows.Count, i).End(xlUp)).Cut Destination:=Cells(lRd, 1)
    Next i
End With
'Final dups removal from the one remaining column
dSht.Range("A1").CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlNo
dSht.Range("A1").EntireRow.Insert
With dSht.Range("A1:B1")
    .Value = Array("Word", "Count")
    .Font.Bold = True
End With
'Get count of each unique word
lRd = dSht.Range("A" & Rows.Count).End(xlUp).Row
dSht.Range("B2").FormulaR1C1 = "=COUNTIF('All Words'!C[-1]:C[" & colCt - 2 & "],'Unique Words'!RC[-1])"
With dSht.Range("B2", "B" & lRd)
    .FillDown
    .Calculate
    .Copy
    .PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End With
With dSht.Range("A1:B1")
    .EntireColumn.AutoFit
End With
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
.StatusBar = False
End With
End Sub
Function CountWords(R As Range) As Long
Dim lChars As Long, c As Range, Ct As Long
For Each c In R
    Ct = 0
    lChars = Len(Trim(c.Value))
    If lChars = 0 Then
        Ct = 0
    Else
        Ct = Len(Trim(c.Value)) - Len(Replace(Trim(c.Value), " ", "")) + 1
    End If
    CountWords = CountWords + Ct
Next c
End Function

一些有用的参考资料：

相关内容