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