Excel – 范围内的所有唯一字词

也许我试图做太多，但我有一个充满文字的列。 每个单元格都有任意数量的单词，例如：

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

我需要做的是创build一个列，该列是该范围内的所有唯一字的列表。 所以对于上面的例子，结果应该是：

  | 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

此选项使用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 

Answer 2

试试这个小macros：

 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