Нашёл макрос
Sub Delete_Duplicates()
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
Всем спасибо!!! Вопрос закрыт
