Sub Удалить_повторы()

    Dim arr(), coll As Collection
    Dim var, lr As Long, i As Long, ii As Long
    
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    arr() = Range("A1").Resize(lr).Value
    
    On Error Resume Next
    For i = 1 To UBound(arr)
        If arr(i, 1) <> "" Then
            Set coll = New Collection
            var = Split(arr(i, 1), ".")
            For ii = 0 To UBound(var)
                coll.Add Item:=var(ii), Key:=var(ii)
            Next ii
            var = Empty
            For ii = 1 To coll.Count
                var = var & coll(ii) & "."
            Next ii
            var = Left(var, Len(var) - 1)
            arr(i, 1) = var
        End If
    Next i
    On Error GoTo 0
    
    Range("A1").Resize(lr).Value = arr()
    MsgBox "Готово!", vbInformation
    
End Sub