Sub DelDublTelefon()
Dim i As Long
Dim iLastRow As Long
Dim j As Integer
Dim dict As Object
    iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Set dict = CreateObject("Scripting.Dictionary")
  For i = 2 To iLastRow
    For j = 2 To 5
      If Cells(i, j) <> "" Then
       If Not dict.exists(CStr(Cells(i, j))) Then    'если нет номера, то добавляем его в словарь
         dict.Add CStr(Cells(i, j)), 1
       Else
         Cells(i, j) = ""
       End If
      End If
    Next
  Next
    Columns("H").ClearContents
    Cells(1, "H").Resize(dict.Count) = Application.Transpose(dict.Keys)
End Sub

Public Sub ClearDublicates()
    Dim pDict As Object, vData As Variant
    Dim i As Long, j As Long, vKey As Variant
    vData = ActiveCell.CurrentRegion.Value
    Set pDict = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(vData, 1)
        For j = 2 To UBound(vData, 2)
            vKey = vData(i, j)
            If pDict.exists(vKey) Then
                vData(i, j) = Empty
            Else
                pDict(vKey) = Empty
            End If
        Next
    Next
    ActiveCell.CurrentRegion = vData
End Sub