Sub iWords()
Dim i As Long
Dim iLastRow As Long
Dim n As Integer
Dim j As Integer
Dim MyArr
 iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
   With CreateObject("scripting.dictionary"): .comparemode = 1
       n = 2
     For i = 2 To iLastRow
       MyArr = Split(Cells(i, "A"), " ")
         For j = 0 To UBound(MyArr)
           If Not .exists(MyArr(j)) Then    'если нет слова, то добавляем его в словарь и в столбец B
             .Add MyArr(j), 1
             Cells(n, "B") = MyArr(j)
             n = n + 1
           End If
         Next
     Next
   End With
    iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
    Range("B1:B" & iLastRow).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlYes
End Sub