代码之家 › 专栏 › 技术社区 › Sebastian Ong

VBA:如何获取列中的唯一值并将其插入数组?

excel-vba vba excel

Sebastian Ong · 技术社区 · 6 年前

我已经看到了关于这个主题的多个代码,但我似乎无法理解它。

例如,如果我有一个记录人名的列,我想将所有唯一的名字记录到数组中。

如果我有一列名字

David
Johnathan
Peter
Peter
Peter
Louis
David

我想利用vba从列中提取唯一的名称并将其放入数组中,这样当我调用数组时,它将返回这些结果

Array[0] = David
Array[1] = Johnathan
Array[2] = Peter
Array[3] = Louis

4 回复 | 直到 6 年前

ThunderFrame 6 年前

尽管 Collection 作为一个可能的解决方案,使用 Dictionary 因为它有一个 Exists 方法。这只是一个问题,如果他们不存在的话,把名字添加到字典中,然后在你完成之后把数组中的键提取出来。

请注意,我已将名称比较区分大小写,但如果需要,可以将其更改为不区分大小写。

Option Explicit

Sub test()

   'Extract all of the names into an array
    Dim values As Variant
    values = Sheet1.Range("Names").Value2 'Value2 is faster than Value

    'Add a reference to Microsoft Scripting Runtime
    Dim dic As Scripting.Dictionary
    Set dic = New Scripting.Dictionary

    'Set the comparison mode to case-sensitive
    dic.CompareMode = BinaryCompare

    Dim valCounter As Long
    For valCounter = LBound(values) To UBound(values)
        'Check if the name is already in the dictionary
        If Not dic.Exists(values(valCounter, 1)) Then
            'Add the new name as a key, along with a dummy value of 0
            dic.Add values(valCounter, 1), 0
        End If
    Next valCounter

    'Extract the dictionary's keys as a 1D array
    Dim result As Variant
    result = dic.Keys

End Sub

DisplayName 6 年前

使用 Dictionary 对象并构建返回数组的函数

Function GetUniqeNames(myRng As Range) As Variant
    Dim cell As Range

    With CreateObject("Scripting.Dictionary") ' instantiate and reference a Dictionary object
        For Each cell In myRng ' loop through passed range
            .Item(cell.Value2) = 1 ' store current cell name into referenced dictionary keys (duplicates will be overwritten)
        Next
    GetUniqeNames = .keys ' write referenced dictionary keys into an array
    End With
End Function

你可以在你的主代码中利用它,如下所示

Sub main()
    Dim myArray As Variant

    With Worksheets("mysheet") ' change "mysheet" to your actual sheet name
        myArray = GetUniqeNames(.Range("A1", .Cells(.Rows.Count, 1).End(xlUp))) ' this will take the referenced sheet column A range from row 1 down to last not empty one
    End With

End Sub

teylyn 6 年前

这是vba问题还是编程逻辑问题?对包含数据的列使用循环。在现有数据项列表中检查每个名称。如果它存在于列表中,请移动下一个名称。如果列表中不存在,请添加它。

“列表”是一个概念,而不是一个具体的工具。如果你愿意的话,它可以是一本vba字典。或者它可以是vba数组,其执行速度可能不如字典,但可能更为熟悉。

同样,如果将数据添加到excel数据模型中,则可以使用透视表的不同聚合列出唯一值。

如果没有更多的背景知识,很难判断vba或数据模型是您的最佳方法。许多vba解决方案是因为人们不知道excel的功能。

Storax 6 年前

您可以使用这样的excel功能。

Sub UniqueNames()

Dim vDat As Variant
Dim rg As Range
Dim i As Long

    Set rg = Range("A1:A7")

    rg.RemoveDuplicates Columns:=Array(1), Header:=xlNo
    With ActiveSheet
        vDat = WorksheetFunction.Transpose(.Range("A1:" & .Range("A1").End(xlDown).Address))
    End With

    For i = LBound(vDat) To UBound(vDat)
        Debug.Print vDat(i)
    Next i

End Sub

代码基于您的示例数据,即我将您的数据放入第1列。但代码也会改变表。如果不想使用其他解决方案,或者事先将数据放入临时工作表中。