Удаление повторяющихся слов в текстовом документе - VBA - Ответ 3804911

Private Sub InitSbls()
    Set pSbls = CreateObject("Scripting.Dictionary")
    pSbls.Add ".", "": pSbls.Add ",", "": pSbls.Add ")", ""
End Sub
 
Private Function IsSymbol(ByVal this As String) As Boolean
    IsSymbol = pSbls.Exists(this)
End Function
 
Public Sub RemoveDubs()
    Dim pWord As Range, sKey As String
    Dim pDict As Object, i As Long, vCount As Long
    Dim pWordCol As New Collection
 
    Set pDict = CreateObject("Scripting.Dictionary")
    InitSbls
    For Each pWord In ThisDocument.Words
        sKey = Trim$(pWord.Text): pWordCol.Add pWord
        
        If Not IsSymbol(sKey) Then
            If Not pDict.Exists(sKey) Then
                pDict.Add sKey, 0
            Else
                pDict(sKey) = pDict(sKey) + 1
            End If
        End If
    Next
    For i = pWordCol.Count To 1 Step -1
        Set pWord = pWordCol(i)
        sKey = Trim$(pWord.Text)
        If pDict.Exists(sKey) Then
            vCount = pDict(sKey)
            If vCount = 0 Then
                pDict.Remove sKey
            Else
                pWord.Delete
                pDict(sKey) = vCount - 1
            End If
        End If
    Next i
End Sub