How can I get a unique set of values?

后端 未结 1 2014
野性不改
野性不改 2020-12-22 10:51

Given some sort of collection of values (an array or a collection of some kind), how can I generate a set of distinct values?

相关标签:
1条回答
  • 2020-12-22 11:29

    Use a Scripting.Dictionary (Tools -> References... -> Microsoft Scripting Runtime):

    Function Unique(values As Variant) As Variant()
        'Put all the values as keys into a dictionary
        Dim dict As New Dictionary
        Dim val As Variant
        For Each val In values
            dict(val) = 1
        Next
        Unique = dict.Keys 'This cannot be done with a Collection, which doesn't expose its keys
    End Function
    

    In VBScript, or in VBA if you prefer using late binding (variables without explicit types):

    Function Unique(values)
        Dim dict, val
        Set dict = CreateObject("Scripting.Dictionary")
        For Each val In values
        ...
    

    If running VBA on a Mac (which doesn't have the Microsoft Scripting Runtime), there is a drop-in replacement for Dictionary available.

    Some examples:

    • Extracting the collection of unique values from a filter in VBA
    • Delete duplicate entries in a given row
    • How to remove duplicate items in listbox
    • How to get unique values from a list of values using VBscript?
    • VBScript:Remove duplicates from an array
    • Word occurrences in VBA
    • Find all distinct values in user based selection - Excel VBA

    Another option (VBA only) is to use a Collection. It's a little more awkward, because there is no way to set an existing key without an error being thrown, and because the returned array has to be created manually:

    Function Unique(values As Variant) As Variant()
        Dim col As New Collection, val As Variant, i As Integer
        For Each val In values
            TryAdd col, val, val
        Next
        Dim ret() As Variant
        Redim ret(col.Count - 1)
        For i = 0 To col.Count-1
            ret(i) = col(i+1)
        Next
        Unique = ret
    End Function
    
    Sub TryAdd(col As Collection, item As Variant, key As String)
        On Error Resume Next
        col.Add(item, key)
    End Sub
    
    0 讨论(0)
提交回复
热议问题