使用具有多個值的過濾列中的唯一值填充數組

Question

我正在嘗試使用過濾后的 Excel 表中的列中的值填充數組。

在此列中，值可能會出現多次，但我需要返回唯一值，而不是每個值的所有出現。

Column F
a
a
a
b
c
c
a
b
d

該數組將具有可變長度，並且根據示例列將具有以下元素：{a, b, c, d}

數組的長度無法固定，因為我的 function 使用長度不同的過濾表。 有時可能只有一個唯一值，有時可能有三個。

我需要這樣做，因為我的數組將用於確定帶有“...”和數組的電子郵件的主題。

如何將列中的唯一值提取到數組中？

Answer 1

使用 Scripting.Dictionary

您可以 select 使用sht.Cells(sht.Rows.Count, "F").End(xlUp).Row列中的所有數據，然后使用Scripting.Dictionary查找您的唯一值。 這是代碼：

'Main Routine
Sub MyMacro()
    Dim sht As Worksheet
    Dim column As Range
    Dim LastRow As Long
    Dim uniqueValues() As Variant

    Set sht = ActiveSheet 'Set your sheet here

    LastRow = sht.Cells(sht.Rows.Count, "F").End(xlUp).Row
    Set column = Range("F1:F" & LastRow)
    uniqueValues = getUniqueValues(column)
    'Do what you need to do with your values [...]
End Sub

'Return unique values from a Range
Function getUniqueValues(column As Range)
    Dim dict As New Scripting.Dictionary ' requires "Microsoft Scripting Runtime"
    Dim cell As Range

    For Each cell In column
        dict(cell.Value) = "1"
    Next

    'A double Transpose will put your data in an Array() format
    getUniqueValues = Application.Transpose(Application.Transpose(dict.Keys))
End Function

如果您不想導入Microsoft Scripting Runtime ，請將此代碼用於dict聲明：

    'If you don't want to import Scripting Runtime, use this code
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

注意：這是經過測試並且可以完美運行。

我希望這有幫助。

Answer 2

您可以將Scripting.Dictionary用於此類任務和xlCellTypeVisible ，例如：

Sub sometest()
    Dim x As Long, cl As Range
    Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
    dic.comparemode = vbTextCompare

    x = Cells(Rows.Count, "A").End(xlUp).Row

    For Each cl In Range(Cells(2, "A"), Cells(x, "A")).SpecialCells(xlCellTypeVisible)
        If Not dic.exists(cl.Value) Then
            dic.Add cl.Value, Nothing
        End If
    Next cl

    Debug.Print Join(dic.keys, ",")

End Sub

測試：