Oscar Sun

                  Sub 檢查儲存格中的重覆()
On Error GoTo eH
Dim SR As Range
Dim cha As Range, b As Boolean
Set SR = Selection.Cells(1).Range
For Each cha In SR.Characters
    If cha = " " Then cha.Delete
    If cha.Font.Name <> "標楷體" Then cha.Delete
Next
x = SR.Text
L = SR.Characters.Count - 1 '末後是格式文字
For i = L To 1 Step -1
    y = SR.Characters(i)
    Z = Replace(x, y, "", 1, 1)
    If StrComp(y, Chr(13)) <> 0 Then
        If InStr(Z, y) > 0 Then
            SR.Characters(i).Select
            SR.Characters(i).Delete
            If InStr(SR, y) = 0 Then
                Stop
                
                SR.Document.Undo
            End If
            b = True
            Exit For
        End If
    End If
Next
If b = False Then MsgBox "沒有重覆的!", vbExclamation
Exit Sub
eH:
Select Case Err.Number
    Case 5941 '集合中所需的成員不存在。
        If ActiveDocument.Path = "" Then Set SR = Selection.Document.Range
        Resume Next
    Case Else
        MsgBox Err.Number & Err.Description
End Select
End Sub