Excel - 範圍內的所有唯一字

Question

也許我試圖做得太多，但我有一個填充文本的列。每個單元有句話任意數量的，因此，例如：

 |   A   | 
=====|====================| 
    1 | apple pear yes cat | 
    2 | apple cat dog  | 
    3 | pear orange  | 

我需要做的就是創建一個列是在該範圍內的所有獨特單詞的列表。所以對於上面的例子，結果應該是：

 |   A   | B | 
=====|====================|========| 
    1 | apple pear yes cat | apple | 
    2 | apple cat dog  | pear | 
    3 | pear orange  | yes | 
    4 |     | cat | 
    5 |     | dog | 
    6 |     | orange | 

沒有特別的順序。有沒有辦法做到這一點？

Answer 1

給這個小宏一試：

Sub dural() 
    Dim N As Long, U As Long, L As Long 
    N = Cells(Rows.Count, "A").End(xlUp).Row 
    Dim st As String 
    For I = 1 To N 
     st = st & " " & Cells(I, 1) 
    Next I 
    st = Application.WorksheetFunction.Trim(st) 
    ary = Split(st, " ") 
    U = UBound(ary) 
    L = LBound(ary) 
    Dim c As Collection 
    Set c = New Collection 
    On Error Resume Next 
    For I = L To U 
     c.Add ary(I), CStr(ary(I)) 
    Next I 
    For I = 1 To c.Count 
     Cells(I, 2).Value = c.Item(I) 
    Next I 
End Sub 

Answer 2

此選項使用1環，而不是3，我喜歡用字典來代替或收藏。

Sub Sample() 
Dim varValues As Variant 
Dim strAllValues As String 
Dim i As Long 
Dim d As Object 

'Create empty Dictionary 
Set d = CreateObject("Scripting.Dictionary") 

'Create String With all possible Values 
strAllValues = Join(Application.Transpose(Range("A1", Range("A" & Rows.Count).End(xlUp))), " ") 

'Split All Values by space into array 
varValues = Split(strAllValues, " ") 

'Fill dictionary with all values (this filters out duplicates) 
For i = LBound(varValues) To UBound(varValues) 
    d(varValues(i)) = 1 
Next i 

'Write All The values back to your worksheet 
Range("B1:B" & d.Count) = Application.Transpose(d.Keys) 
End Sub