时间戳

首页 > 解决方案 > 使用数组计算文本中的单词和短语匹配

vba - 使用数组计算文本中的单词和短语匹配

问题描述

我是 VBA 新手，正在尝试创建一个工作项目。我们根据他们收听和输入的样本测试文件聘请转录员。我一直在尝试编写一个宏来搜索特定关键字的测试（其中一些在测试中多次使用），然后给出一个带有结果的消息框。这样我们就可以一目了然地衡量能力。

我已经组装了一个原型，但有一个主要问题：计数器似乎计数不正确。我在一个包含所有必需关键字的示例文件上对其进行了测试，但它只会注册大约一半的关键字。我不确定问题出在哪里，并希望有任何见解。

我的代码在下面，并附上了生成的消息框的屏幕截图。

Sub WordCountTest()

    ' WordCountTest Macro

    'create definitions for search
    Dim wrd As range
    Dim var As Variant
    Dim searchlist()
    Dim numfound() As Integer
    Dim idx As Integer
    Dim strResults As String

    'necessary search terms
    searchlist = Array("Deposition Subpoena", "Amend Notice of Deposition", _
                       "fellowed", "corneal", "refractive", "LASIK", _
                       "1989", "Cedars-Sinai", "Capital", _
                       "January 28 2016", "technicians'", _
                       "topography", "OCT", "sclera", _
                       "limbus sclerocorneal", "fundoscopy", _
                       "Indirect ophthalmoscope", "diopter", _
                       "Keratometry", "Tomey", _
                       "Cirrus OCT tomographer", _
                       "No, not on the front", "ablation")

    'searching text
    ReDim numfound(0 To UBound(searchlist))
    For Each wrd In ActiveDocument.Words
        idx = 0
        For Each var In searchlist
            If Trim(wrd.Text) = searchlist(idx) Then
                numfound(idx) = numfound(idx) + 1
            End If
            idx = idx + 1
        Next var
    Next wrd

    idx = 0
    For Each var In searchlist
        strResults = strResults & searchlist(idx) & " : " & _
                     numfound(idx) & vbCr
        idx = idx + 1
    Next var

    MsgBox strResults

End Sub

消息框截图

标签： vbams-word

解决方案

尝试：

Sub Demo()
Application.ScreenUpdating = False
Dim ArrFnd, strOut As String, i As Long, j As Long, k As Long
ArrFnd = Array("Deposition Subpoena", "Amend Notice of Deposition", _
  "fellowed", "corneal", "refractive", "LASIK", "1989", "Cedars-Sinai", _
  "Capital", "January 28 2016", "technicians'", "topography", "OCT", _
  "limbus sclerocorneal", "fundoscopy", "Indirect ophthalmoscope", _
  "sclera", "diopter", "Keratometry", "Tomey", "Cirrus OCT tomographer", _
  "No, not on the front", "ablation")
For i = 0 To UBound(ArrFnd)
  j = 0
  With ActiveDocument.Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = ArrFnd(i)
      .Replacement.Text = ""
      .Forward = True
      .Format = False
      .Wrap = wdFindStop
      .Execute
    End With
    Do While .Find.Found
      j = j + 1
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
  End With
  k = k + j
  strOut = strOut & vbCr & ArrFnd(i) & ": " & j
Next
Application.ScreenUpdating = True
MsgBox "Results -" & strOut & vbCr & vbCr & "TOTAL: " & k
End Sub

推荐阅读