Arrays 读取excel列并将其唯一值放入数组中

我有一列具有不同的值。我必须只从列中选择唯一的值并将其放入数组中

我使用下面的代码来处理相同的问题，但它将唯一的值放在另一列而不是数组中

Sub GetUniqueSections()
Dim d As Object, c As Variant, i As Long, lastRow As Long
Dim a(8) As String
Dim j
Set d = CreateObject("Scripting.Dictionary")
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
c = Range("C2:C" & lastRow)
For i = 1 To UBound(c, 1)
  d(c(i, 1)) = 1

Next i

Range("R2").Resize(d.Count) = Application.Transpose(d.Keys)
End Sub

---

在下面的代码中，

UniqueValueArrayFromRange

使用与

Scripting.Dictionary

相同的技术替换

GetUniqueSections

。您可以用所需的任何内容替换

“A1:A14”

，输出数组将位于

arr

：

Option Explicit

Sub Test()
    Dim rng As Range
    Dim arr As Variant
    Dim i As Integer

    ' pass range values to function for unique values
    Set rng = Sheet1.Range("A1:A14")
    arr = UniqueValueArrayFromRange(rng)

    ' test return values
    For i = LBound(arr) To UBound(arr)
        Debug.Print arr(i)
    Next i

End Sub

Function UniqueValueArrayFromRange(ByRef rngSource As Range) As Variant
    Dim dic As Object
    Dim rngCell As Range

    ' create dictionary and only add new values
    Set dic = CreateObject("Scripting.Dictionary")
    For Each rngCell In rngSource
        If Not dic.Exists(rngCell.Value) Then
            dic.Add rngCell.Value, 1
        End If
    Next rngCell

    ' return key collection as array
    UniqueValueArrayFromRange = dic.Keys

End Function

---

所以您知道您将有8个唯一的值？在填充数组后，您想对它做什么？非常好！您可以删除

rng。不过，请在
子测试（）中选择
。没必要。