Sub ДУБЛИ_ВЯЧЕЙКЕ_УДЛАИТЬ()
    Dim col As New Collection
    Dim i As Integer
    On Error Resume Next
 
    For Each cell In Selection
        Set col = Nothing
        sResult = ""
         
        'делим текст в ячейке по пробелам
        arWords = Split(WorksheetFunction.Trim(cell.Value), " ")
         
        'проходим в цикле по всем получившимся словам
        For i = LBound(arWords) To UBound(arWords)
            Err.Clear                           'сбрасываем ошибки
            col.Add arWords(i), arWords(i)      'пробуем добавить слово в коллекцию
            'если ошибки не возникает, то это не повтор - добавляем слово к результату
            If Err.Number = 0 Then sResult = sResult & " " & arWords(i)
        Next i
        cell.Value = Trim(sResult)      'выводим результаты без повторов
    Next cell
End Sub

Sub bb()
Dim c As Range, x
With CreateObject("scripting.dictionary")
  For Each c In Selection
    .RemoveAll
    For Each x In Split(c)
      .Item(x) = 0
    Next
    c = Join(.keys)
  Next
End With
End Sub