2013-11-15 80 views
3

也許我試圖做得太多,但我有一個填充文本的列。每個單元有句話任意數量的,因此,例如:Excel - 範圍內的所有唯一字

 |   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 | 

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

+1

使用vba是的,但我知道沒有公式或簡單的一系列步驟使用嵌入式功能來實現所需的結果。 – xQbert

回答

0

給這個小宏一試:

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 
3

此選項使用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 
+0

+1非常好地完成! – brettdj

相關問題