Question

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

我正在使用以下代码，但它将唯一值放在另一列而不是数组中。

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

Answer 1

在下面的代码中，UniqueValueArrayFromRange使用与GetUniqueSections相同的技术替换您的Scripting.Dictionary。您可以将"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

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

1 个答案: