Word VBA技术：统计文档中每个字母字符的数量

Sub FindNumberOfEachCharacterInActiveDocument_SortedAlphabetically()
 Dim strText As String
 Dim strTextNew As String
 Dim lngCount As Long
 Dim strInfo As String
 Dim strMsg As String
 Dim lngTotal As Long
 Dim strCharacters As String
 Dim strChar As String

 '为便于编辑要计数的字符列表,
 '列表定义为字符串,strCharacters.
 '按你的需要编辑这个字符串 - 例如,添加要统计的数字.
 '不区分大小写.

  strCharacters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

  strMsg = ""
  strText = UCase(ActiveDocument.Range.Text)
  lngTotal = Len(strText)

  For lngCount = 1 To Len(strCharacters)
      '从strCharacters中获取字符
      strChar = Mid(strCharacters, lngCount, 1)

      '要获取出现的次数:
      '使用""代替strChar并计算不同的长度
      strTextNew = Replace(UCase(strText), strChar, "")
      strInfo = strChar & ":" & vbTab & lngTotal - Len(strTextNew) & vbCr
      '追加信息到消息框
      strMsg = strMsg & strInfo
  Next lngCount

  '在对话框显示信息
  strMsg = strMsg & vbCr & vbCr & _
    "主文档中字母数量: " & lngTotal
  '如果列表strCharacters没有按字母顺序排列，
  '你应该编辑下面的MsgBox标题
   MsgBox strMsg, vbOKOnly, "按字母顺序统计"
End Sub

Sub FindNumberOfEachCharacterInActiveDocument_SortedByOccurrences()
  Dim strText As String
  Dim strTextNew As String
  Dim lngCount As Long
  Dim strInfo As String
  Dim strMsg As String
  Dim lngTotal As Long
  Dim lngChar As Long
  Dim strCharacters As String
  Dim strChar As String
  Dim oDocTemp As Document
  Dim oTable As Table

  Application.ScreenUpdating = False

 '为便于编辑要计数的字符列表,
 '列表定义为字符串,strCharacters.
 '按你的需要编辑这个字符串 - 例如,添加要统计的数字.
 '不区分大小写.

  strCharacters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

  strMsg = ""
  strText = UCase(ActiveDocument.Range.Text)
  lngTotal = Len(strText)

  '创建用于存储字符计数和执行排序的临时文档
  '阻止自动新建宏运行（如果找到）
  WordBasic.DisableAutoMacros 1
  Set oDocTemp = Documents.Add

 '插入用于为最终消息添加信息的表
  With oDocTemp
     .Range.Text = ""
     '插入2列表, 行数 = strCharacters的长度
     Set oTable = .Tables.Add(.Range, Len(strCharacters), 2)
  End With

 '添加strCharacters中每个字符的信息
  For lngCount = 1 To Len(strCharacters)
      '从strCharacters获取字符
      strChar = Mid(strCharacters, lngCount, 1)

      '要获取出现的次数:
      '使用""代替strChar并计算不同的长度
      strTextNew = Replace(UCase(strText), strChar, "")
      lngChar = lngTotal - Len(strTextNew)
      '在表中单元格2插入结果
      oTable.Cell(lngCount, 2).Range.Text = lngChar
     '在表中单元格1插入字符
      oTable.Cell(lngCount, 1).Range.Text = strChar
   Next lngCount

   '按列2排序表并转换成文本
   oTable.Sort ExcludeHeader:=False, FieldNumber:="Column 2", _
       SortFieldType:=wdSortFieldNumeric,
       SortOrder:=wdSortOrderDescending

   oTable.Rows.ConvertToText Separator:=wdSeparateByTabs
   '从oDocTemp存储文本, 准备在最终消息中使用
    strInfo = oDocTemp.Range.Text

    '不保存关闭oDocTemp
    oDocTemp.Close wdDoNotSaveChanges

    Application.ScreenUpdating = True

    '在对话框中显示信息
    strMsg = strInfo & vbCr & vbCr & _
       "主文档中字母数量: " & lngTotal
    MsgBox strMsg, vbOKOnly, "按字符统计数值降序排列"

    '清理
    Set oDocTemp = Nothing
    Set oTable = Nothing

    '再次启用自动运行宏
     WordBasic.DisableAutoMacros 0
End Sub