Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Option Explicit
- Sub Find_Duplicates()
- On Error GoTo errHandler
- Dim pSingleLine As Paragraph
- Dim sLine As String
- Dim sFull_Text As String
- Dim vArray_Full_Text As Variant
- Dim sSearch_3 As String
- Dim lSize_Array As Long
- Dim lCnt As Long
- Dim lCnt_Occurence As Long
- 'Create a string from the entire text
- For Each pSingleLine In ActiveDocument.Paragraphs
- sLine = pSingleLine.Range.Text
- sFull_Text = sFull_Text & sLine
- Next pSingleLine
- 'Load the text into an array
- vArray_Full_Text = sFull_Text
- vArray_Full_Text = Split(sFull_Text, " ")
- lSize_Array = UBound(vArray_Full_Text)
- For lCnt = 1 To lSize_Array - 1
- lCnt_Occurence = 0
- sSearch_3 = Trim(fRemove_Punctuation(vArray_Full_Text(lCnt - 1) & _
- " " & vArray_Full_Text(lCnt) & _
- " " & vArray_Full_Text(lCnt + 1)))
- With Selection.Find
- .Text = sSearch_3
- .Forward = True
- .Replacement.Text = ""
- .Wrap = wdFindContinue
- .Format = False
- .MatchCase = False
- Do While .Execute
- lCnt_Occurence = lCnt_Occurence + 1
- If lCnt_Occurence > 1 Then
- Selection.Range.Font.Color = vbRed
- End If
- Selection.MoveRight
- Loop
- End With
- Application.StatusBar = lCnt & "/" & lSize_Array
- Next lCnt
- errHandler:
- Stop
- End Sub
- Public Function fRemove_Punctuation(sString As String) As String
- Dim vArray(0 To 8) As String
- Dim lCnt As Long
- vArray(0) = "."
- vArray(1) = ","
- vArray(2) = ","
- vArray(3) = "?"
- vArray(4) = "!"
- vArray(5) = ";"
- vArray(6) = ":"
- vArray(7) = "("
- vArray(8) = ")"
- For lCnt = 0 To UBound(vArray)
- If Left(sString, 1) = vArray(lCnt) Then
- sString = Right(sString, Len(sString) - 1)
- ElseIf Right(sString, 1) = vArray(lCnt) Then
- sString = Left(sString, Len(sString) - 1)
- End If
- Next lCnt
- fRemove_Punctuation = sString
- End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement