如何从 Excel VBA 中的范围中获取唯一值列表？

How do I get a list of unique values from a range in Excel VBA?

提问by lakesh

I would like to get a list of unique values in a range using VBA. Most examples in Google talk about getting a list of unique values in a column using VBA.

我想使用 VBA 获取某个范围内的唯一值列表。Google 中的大多数示例都涉及使用 VBA 获取列中唯一值的列表。

I am not sure how to change it to get a list of value in a range.

我不确定如何更改它以获取范围内的值列表。

For example,

例如，

Currency    Name 1  Name 2  Name 3  Name 4  Name 5
SGD BGN DBS         
PHP PDSS                
KRW BGN             
CNY CBBT    BGN         
IDA INPC                

My array should look like:

我的数组应该是这样的：

BGN, DBS, PDSS, CBBT and INPC.

How do I do it? Need some guidance.

我该怎么做？需要一些指导。

回答by dee

I would use a simple VBA-Collectionand add items with key. The key would be the item itself and because there can't be duplicit keys the collection will contain unique values.

我会使用一个简单的VBA-Collection并用键添加项目。键是项目本身，因为不能有重复的键，集合将包含唯一值。

Note: Because adding duplicit key to collection raises error wrap the call to collection-add into a on-error-resume-next.

注意：因为向集合添加重复键会引发错误，所以将对 collection-add 的调用封装到 on-error-resume-next 中。

The function GetUniqueValueshas source-range-valuesas parameter and retuns VBA-Collectionof unique source-range-values. In the mainmethod the function is called and the result is printed into Output-Window. HTH.

该函数GetUniqueValues具有源范围值作为参数和retunsVBA-Collection的独特来源范围值。在该main方法中调用该函数并将结果打印到输出窗口中。哈。

Sample source range looked like this:

样本源范围如下所示：

Option Explicit

Sub main()
    Dim uniques As Collection
    Dim source As Range

    Set source = ActiveSheet.Range("A2:F6")
    Set uniques = GetUniqueValues(source.Value)

    Dim it
    For Each it In uniques
        Debug.Print it
    Next
End Sub

Public Function GetUniqueValues(ByVal values As Variant) As Collection
    Dim result As Collection
    Dim cellValue As Variant
    Dim cellValueTrimmed As String

    Set result = New Collection
    Set GetUniqueValues = result

    On Error Resume Next

    For Each cellValue In values
        cellValueTrimmed = Trim(cellValue)
        If cellValueTrimmed = "" Then GoTo NextValue
        result.Add cellValueTrimmed, cellValueTrimmed
NextValue:
    Next cellValue

    On Error GoTo 0
End Function

Output

输出

SGD
PHP
KRW
CNY
IDA
BGN
PDSS
CBBT
INPC
DBS
a

---

---

In case when the source range consists of areas get the values of all the areas first.

如果源范围由区域组成，则首先获取所有区域的值。

Public Function GetSourceValues(ByVal sourceRange As Range) As Collection
    Dim vals As VBA.Collection
    Dim area As Range
    Dim val As Variant
    Set vals = New VBA.Collection
    For Each area In sourceRange.Areas
        For Each val In area.Value
            If val <> "" Then _
                vals.Add val
        Next val
    Next area
    Set GetSourceValues = vals
End Function

Source type is now Collection but then all works the same:

源类型现在是 Collection 但所有的工作方式都一样：

Dim uniques As Collection
Dim source As Collection

Set source = GetSourceValues(ActiveSheet.Range("A2:F6").SpecialCells(xlCellTypeVisible))
Set uniques = GetUniqueValues(source)

回答by CBRF23

Loop through the range, check if the value is in the array, if not add it to the array.

循环遍历范围，检查该值是否在数组中，如果没有则将其添加到数组中。

Sub test()
Dim Values() As Variant
Values = GetUniqueVals(Selection)
Dim i As Integer
    For i = LBound(Values) To UBound(Values)
        Debug.Print (Values(i))
    Next

End Sub

Function GetUniqueVals(ByRef Data As Range) As Variant()
    Dim cell As Range
    Dim uniqueValues() As Variant
    ReDim uniqueValues(0)

    For Each cell In Data
        If Not IsEmpty(cell) Then
            If Not InArray(uniqueValues, cell.Value) Then
                If IsEmpty(uniqueValues(LBound(uniqueValues))) Then
                    uniqueValues(LBound(uniqueValues)) = cell.Value
                Else
                    ReDim Preserve uniqueValues(UBound(uniqueValues) + 1)
                    uniqueValues(UBound(uniqueValues)) = cell.Value
                End If
            End If
        End If
    Next
    GetUniqueVals = uniqueValues
End Function

Function InArray(ByRef SearchWithin() As Variant, ByVal SearchFor As Variant) As Boolean
    Dim i As Integer
    Dim matched As Boolean 'Default value of boolean is false, we make true only if we find a match

    For i = LBound(SearchWithin) To UBound(SearchWithin)
        If SearchWithin(i) = SearchFor Then matched = True
    Next

    InArray = matched
End Function

回答by BruceWayne

As of Excel 365, they have introduced the UNIQUE()Worksheet Function.

从 Excel 365 开始，他们引入了UNIQUE()工作表功能。

From Microsoft:

来自微软：

The UNIQUE function returns a list of unique values in a list or range.

UNIQUE 函数返回列表或范围中的唯一值列表。

=UNIQUE(Range,[by_col],[exactly_once])

=UNIQUE(Range,[by_col],[exactly_once])

This formula will output the unique values in multiple cells:

此公式将输出多个单元格中的唯一值：

So entering the formula in A3, I wouldn't be able to use B3, or C3as they contain some of the results.

因此，在 中输入公式A3，我将无法使用B3，或者C3因为它们包含某些结果。

So, for VBA you can just use Evaluate():

因此，对于 VBA，您可以使用Evaluate()：

Dim uniques as Variant
uniques = Evalute("Unique(" & rng.Address & ",TRUE,FALSE)")

Which returns them in an array (Note:The index starts at 1here, not 0).

它将它们以数组形式返回（注意：索引从1这里开始，而不是0）。