搜索Word内置方法列出文档中最重复的单词

Question

Visual Basic 应用程序 (VBA) 自 1993 年以来一直是 Word 的一部分。这种古老的编程语言非常原始且难以使用，这可能就是您在这里寻求帮助的原因。

实际使用方法 Allen Wyatt 的 VBA 宏非常简单，如下所述。

除了以下步骤之外，观看 YouTube 上的一段逐步解释该过程的视频可能会更简单： Word - 生成单词出现次数统计（作者 Chris Menard）。

视频中描述的过程如下：

应首先保存文档以.docm允许宏
使用Alt+F11进入 VBA 编辑器

使用菜单插入 > 模块并复制粘贴以下内容，创建一个名为的宏WordFrequency：

  Sub WordFrequency()
      Const maxwords = 9000          'Maximum unique words allowed
      Dim SingleWord As String       'Raw word pulled from doc
      Dim Words(maxwords) As String  'Array to hold unique words
      Dim Freq(maxwords) As Integer  'Frequency counter for unique words
      Dim WordNum As Integer         'Number of unique words
      Dim ByFreq As Boolean          'Flag for sorting order
      Dim ttlwds As Long             'Total words in the document
      Dim Excludes As String         'Words to be excluded
      Dim Found As Boolean           'Temporary flag
      Dim j, k, l, Temp As Integer   'Temporary variables
      Dim ans As String              'How user wants to sort results
      Dim tword As String            '
      Dim aword As Object            '
      Dim tmpName As String          '

      ' Set up excluded words
      Excludes = "[the][a][of][is][to][for][by][be][and][are]"

      ' Find out how to sort
      ByFreq = True
      ans = InputBox("Sort by WORD or by FREQ?", "Sort order", "WORD")
      If ans = "" Then End
      If UCase(ans) = "WORD" Then
          ByFreq = False
      End If

      Selection.HomeKey Unit:=wdStory
      System.Cursor = wdCursorWait
      WordNum = 0
      ttlwds = ActiveDocument.Words.Count

      ' Control the repeat
      For Each aword In ActiveDocument.Words
          SingleWord = Trim(LCase(aword))
          'Out of range?
          If SingleWord < "a" Or SingleWord > "z" Then
              SingleWord = ""
          End If
          'On exclude list?
          If InStr(Excludes, "[" & SingleWord & "]") Then
              SingleWord = ""
          End If
          If Len(SingleWord) > 0 Then
              Found = False
              For j = 1 To WordNum
                  If Words(j) = SingleWord Then
                      Freq(j) = Freq(j) + 1
                      Found = True
                      Exit For
                  End If
              Next j
              If Not Found Then
                  WordNum = WordNum + 1
                  Words(WordNum) = SingleWord
                  Freq(WordNum) = 1
              End If
              If WordNum > maxwords - 1 Then
                  j = MsgBox("Too many words.", vbOKOnly)
                  Exit For
              End If
          End If
          ttlwds = ttlwds - 1
          StatusBar = "Remaining: " & ttlwds & ", Unique: " & WordNum
      Next aword

      ' Now sort it into word order
      For j = 1 To WordNum - 1
          k = j
          For l = j + 1 To WordNum
              If (Not ByFreq And Words(l) < Words(k)) _
                Or (ByFreq And Freq(l) > Freq(k)) Then k = l
          Next l
          If k <> j Then
              tword = Words(j)
              Words(j) = Words(k)
              Words(k) = tword
              Temp = Freq(j)
              Freq(j) = Freq(k)
              Freq(k) = Temp
          End If
          StatusBar = "Sorting: " & WordNum - j
      Next j

      ' Now write out the results
      tmpName = ActiveDocument.AttachedTemplate.FullName
      Documents.Add Template:=tmpName, NewTemplate:=False
      Selection.ParagraphFormat.TabStops.ClearAll
      With Selection
          For j = 1 To WordNum
              .TypeText Text:=Trim(Str(Freq(j))) _
                & vbTab & Words(j) & vbCrLf
          Next j
      End With
      System.Cursor = wdCursorNormal
      j = MsgBox("There were " & Trim(Str(WordNum)) & _
        " different words ", vbOKOnly, "Finished")
  End Sub

您可以F5在编辑器中使用来运行/测试宏
在日常使用中，您可以WordFrequency从 “开发人员”选项卡
对于频繁使用，您可以将宏分配给功能区按钮或者为了更容易激活将宏添加到快速访问工具栏。

首先在一个小的文档上进行测试，因为在一个大的文档上这个宏需要一些时间才能完成。

Answer 1