Advertisement
Guest User

Untitled

a guest
Apr 27th, 2015
31
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.12 KB | None | 0 0
  1. Option Explicit
  2.  
  3. Sub Find_Duplicates()
  4.  
  5. On Error GoTo errHandler
  6.  
  7. Dim pSingleLine As Paragraph
  8. Dim sLine As String
  9. Dim sFull_Text As String
  10. Dim vArray_Full_Text As Variant
  11.  
  12. Dim sSearch_3 As String
  13. Dim lSize_Array As Long
  14. Dim lCnt As Long
  15. Dim lCnt_Occurence As Long
  16.  
  17.  
  18. 'Create a string from the entire text
  19. For Each pSingleLine In ActiveDocument.Paragraphs
  20. sLine = pSingleLine.Range.Text
  21. sFull_Text = sFull_Text & sLine
  22. Next pSingleLine
  23.  
  24. 'Load the text into an array
  25. vArray_Full_Text = sFull_Text
  26. vArray_Full_Text = Split(sFull_Text, " ")
  27. lSize_Array = UBound(vArray_Full_Text)
  28.  
  29.  
  30. For lCnt = 1 To lSize_Array - 1
  31. lCnt_Occurence = 0
  32. sSearch_3 = Trim(fRemove_Punctuation(vArray_Full_Text(lCnt - 1) & _
  33. " " & vArray_Full_Text(lCnt) & _
  34. " " & vArray_Full_Text(lCnt + 1)))
  35.  
  36. With Selection.Find
  37. .Text = sSearch_3
  38. .Forward = True
  39. .Replacement.Text = ""
  40. .Wrap = wdFindContinue
  41. .Format = False
  42. .MatchCase = False
  43.  
  44. Do While .Execute
  45.  
  46. lCnt_Occurence = lCnt_Occurence + 1
  47. If lCnt_Occurence > 1 Then
  48. Selection.Range.Font.Color = vbRed
  49. End If
  50. Selection.MoveRight
  51. Loop
  52. End With
  53.  
  54. Application.StatusBar = lCnt & "/" & lSize_Array
  55. Next lCnt
  56.  
  57. errHandler:
  58. Stop
  59.  
  60. End Sub
  61.  
  62. Public Function fRemove_Punctuation(sString As String) As String
  63.  
  64. Dim vArray(0 To 8) As String
  65. Dim lCnt As Long
  66.  
  67.  
  68. vArray(0) = "."
  69. vArray(1) = ","
  70. vArray(2) = ","
  71. vArray(3) = "?"
  72. vArray(4) = "!"
  73. vArray(5) = ";"
  74. vArray(6) = ":"
  75. vArray(7) = "("
  76. vArray(8) = ")"
  77.  
  78. For lCnt = 0 To UBound(vArray)
  79. If Left(sString, 1) = vArray(lCnt) Then
  80. sString = Right(sString, Len(sString) - 1)
  81. ElseIf Right(sString, 1) = vArray(lCnt) Then
  82. sString = Left(sString, Len(sString) - 1)
  83. End If
  84. Next lCnt
  85.  
  86. fRemove_Punctuation = sString
  87.  
  88. End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement