Word VBA 選取處作汰重

https://snipsave.com/oscarsun72/#/snippet/45jki8gtXugIzAt8jg
Sub 選取處作汰重(Ctrl As Boolean) '，若無選取則以段落為單位 Dim rng As Range, rngR As Range, a, b, flg As Boolean ', j As Long, i As Long, s As Long If Selection.Type = wdSelectionIP Then Set rng = Selection.Paragraphs(1).Range Else Set rng = d.ActiveWindow.Selection.Range End If 'If Ctrl Then For Each a In rng.Characters If a.End = rng.Document.Range.End Then Exit For If Not a.Next Is Nothing Then Set b = a.Next Else Exit For End If Set rngR = rng.Document.Range(b.Start, rng.End) For Each b In rngR.Characters If VBA.StrComp(a, b) = 0 And Asc(a) <> 13 Then If Ctrl Then b.Delete If flg = False Then flg = True If rngR.Characters.Count = 1 Then If Asc(b) = 13 Then Exit For End If Else b.Font.Color = 192 If flg = False Then flg = True 'Application.ScreenRefresh 'Application.ScreenUpdating = True End If End If Next b Next a 'Else ' s = rng.Characters.Count ' For Each a In rng.Characters ' j = j + 1 ' If a.Font.Color <> 192 Then ' For i = j To s ' If InStr(VBA.Chr(13) & VBA.Chr(7) & VBA.Chr(9) & VBA.Chr(10), a) = 0 Then ' If StrComp(rng.Characters(i), a, vbTextCompare) = 0 And j <> i Then ' rng.Characters(i).Font.Color = 192 '深紅色 ' 'Application.ScreenRefresh ' 'Application.ScreenUpdating = True ' flg = True ' 'MsgBox "有重複!", vbExclamation ' 'Exit Sub ' End If ' End If ' Next ' End If ' Next a 'End If If flg Then If Ctrl Then MsgBox "有重複!已重複者已刪除", vbExclamation Ctrl = False Else MsgBox "有重複!已標成深紅字", vbExclamation End If Else MsgBox "沒有重複!", vbInformation End If End Sub