Ocurrencias de palabras en VBA: cómo acelerar
Necesito escribir una macro de MS Word para contar la aparición de cada palabra dentro de un documento determinado e imprimir la lista como. Hice la macro y funciona, pero es tan lenta que lleva varias horas obtener resultados para un documento de 60000 palabras. ¿Podría darme algunos consejos / sugerencias sobre cómo hacer que la macro se ejecute más rápido?
(Marqué una pregunta similar aquíWORD VBA Count Word Ocurrencias pero todavía no entiendo cómo acelerar y necesito revisar mi macro). Gracias.
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