Eu preciso escrever uma macro do MS Word para contar a ocorrência de cada palavra em um determinado documento e imprimir a lista como. Fiz a macro e ela funciona, mas é tão lenta que leva várias horas para obter resultados para um documento de 60000 palavras. Poderia me dar alguns conselhos / sugestões sobre como acelerar a macro?

(Verifiquei uma pergunta semelhante aquiWORD VBA Count Ocorrências de palavras mas ainda não entendi como acelerar e preciso que minha macro seja revisada). Obrigado.

Private Type WordStatData
    WordText As String
    WordCount As Integer
End Type

Option Base 1
'Check if the word is valid

Private Function IsValidWord(SomeString As String) As Boolean
    Dim Retval As Boolean
    Retval = True
    If Not (InStr(SomeString, " ") = 0) Then Retval = False
    If Not (InStr(SomeString, ".") = 0) Then Retval = False
    If Not (InStr(SomeString, ",") = 0) Then Retval = False
    If Not InStr(SomeString, "0") = 0 Then Retval = False
    If Not InStr(SomeString, "1") = 0 Then Retval = False
    If Not InStr(SomeString, "2") = 0 Then Retval = False
    If Not InStr(SomeString, "3") = 0 Then Retval = False
    If Not InStr(SomeString, "4") = 0 Then Retval = False
    If Not InStr(SomeString, "5") = 0 Then Retval = False
    If Not InStr(SomeString, "6") = 0 Then Retval = False
    If Not InStr(SomeString, "7") = 0 Then Retval = False
    If Not InStr(SomeString, "8") = 0 Then Retval = False
    If Not InStr(SomeString, "9") = 0 Then Retval = False
    IsValidWord = Retval
End Function

Private Sub CommandButton1_Click()
    SpanishLCID = 3082 'The source text is in Spanish
    ListBox1.Clear
    Dim WordsTotal As Long
    WordsTotal = ActiveDocument.Words.Count
    TextBox1.Text = Str(WordsTotal)
    Dim Wordfound As Boolean
    Dim NewWord As String
    Dim MyData() As WordStatData
    ReDim Preserve MyData(1)
    NewWord = ""
    For i = 1 To WordsTotal
        NewWord = Trim(StrConv(Trim(ActiveDocument.Words(i)), vbLowerCase, SpanishLCID))
        'Check if the word is in the list
        If IsValidWord(NewWord) Then
            Wordfound = False
            For j = 1 To UBound(MyData)
                If StrComp(MyData(j).WordText, NewWord) = 0 Then
                    Wordfound = True: Exit For
                End If
            Next j
            If Wordfound Then
                MyData(j).WordCount = MyData(j).WordCount + 1
            Else
                ReDim Preserve MyData(UBound(MyData) + 1)
                MyData(UBound(MyData)).WordText = NewWord
                MyData(UBound(MyData)).WordCount = 1
            End If
        End If
    Next i
    'Printing out the word list
    For i = 1 To UBound(MyData)
        ListBox1.AddItem (MyData(i).WordText & "=" & Str(MyData(i).WordCount))
    Next i
End Sub