如何从Excel VBA中的某个范围中获取唯一值列表? [英] How do I get a list of unique values from a range in Excel VBA?

问题描述

我想使用VBA获得范围内唯一值的列表. Google中的大多数示例都谈到使用VBA在列中获取唯一值列表.

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.

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

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

例如，

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

我的数组应如下所示:

BGN, DBS, PDSS, CBBT and INPC.

我该怎么做?需要一些指导.

How do I do it? Need some guidance.

推荐答案

我将使用简单的VBA-Collection并添加带有键的项目.密钥将是项目本身，并且因为没有重复密钥，所以集合将包含唯一值.

I would use a simple VBA-Collection and 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.

注意:由于向集合添加重复密钥会引发错误，因此将对collection-add的调用包装到on-error-resume-next中.

函数GetUniqueValues以 source-range-values 作为参数，并重新调整唯一的source-range-values 的VBA-Collection.在main方法中，该函数被调用，结果被打印到Output-Window中. HTH.

The function GetUniqueValues has source-range-values as parameter and retuns VBA-Collection of unique source-range-values. In the main method the function is called and the result is printed into Output-Window. HTH.

样本来源范围如下所示:

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

输出

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

源类型现在为Collection，但随后所有功能都相同:

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

Dim uniques As Collection
Dim source As Collection

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

这篇关于如何从Excel VBA中的某个范围中获取唯一值列表?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！