удаления строк с повторяющимися элементами

[satten]

Добрый день!
Помогите пожалуйста. Есть текст с номерами телефонов. Текст может быть любой а номера одинаковые, нужно чтоб макрос искал строки с повторяющимися номерами и удалял все строки кроме одной, которые имеют такой же номер.
Заранее благодарен.

[satten]

Вот тут пример.

[EducatedFool]

Sub RemoveDuplicates()
    Dim cell As Range, ra As Range, coll As New Collection: Application.ScreenUpdating = False
    On Error Resume Next
    For Each cell In Range([b1], Range("b" & Rows.Count).End(xlUp)).Cells
        arr = "": arr = Split(cell.Text, " Т.")
        If UBound(arr) <> 1 Then
            Debug.Print "Не обработана строка " & cell.Row
        Else
            For Each tel In Split(arr(1), ",")
                numb = JustDigits(tel)
                If Len(numb) Then
                    Err.Clear: coll.Add CStr(numb), CStr(numb)
                    If Err Then
                        If ra Is Nothing Then Set ra = cell Else Set ra = Union(ra, cell)
                        Exit For
                    End If
                End If
            Next tel
        End If
    Next cell
    Err.Clear
    MsgBox "Найдено строк-дубликатов: " & ra.Cells.Count, vbInformation
    If Err Then MsgBox "Cтрок-дубликатов не найдено!", vbInformation
    ra.EntireRow.Delete
End Sub

Function JustDigits(ByVal txt) As String
    For i = 1 To Len(txt)
        If Mid(txt, i, 1) Like "#" Then JustDigits = JustDigits & Mid(txt, i, 1)
    Next
End Function