Question

我从列中提取唯一值，并将它们放在一个包含如下代码的数组中：

Range("A1:A27").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("Z1"), Unique:=True
Univoci = Range("Z1").CurrentRegion.Value

问题是：可以将它们直接放入数组中吗？

我的意思是使用一个命令或使用最少的代码（我知道我可以通过将每个项目与其他项目进行比较来获得唯一值）

提前致谢

Answer 1

这将获得A列中的唯一文本项并将它们放在B列中

Sub GetuniqueItems()

    Dim Rws As Long, Rng As Range, c
    Dim Col As New Collection, Ar(), x

    Rws = Cells(Rows.Count, "A").End(xlUp).Row
    Set Rng = Range(Cells(2, 1), Cells(Rws, 1))

    On Error Resume Next

    For Each c In Rng.Cells

        Col.Add c.Value, c.Value

    Next c

    On Error GoTo 0

    ReDim Ar(1 To Col.Count)

    For x = 1 To Col.Count

        Ar(x) = Col(x)

    Next x

    Range("B1").Resize(Col.Count, 1).Value = WorksheetFunction.Transpose(Ar)

End Sub

Answer 2

我不确定是否有办法实现并填充具有独特值的数组，但您可以使用字典来构建唯一条目

  Set Dict = CreateObject("Scripting.Dictionary")
  For Each Cell In Range("A1:A27")
    If Not Dict.Exists(Cell.Value) Then Dict.Add Cell.Value, Cell.Address
  Next

  Dim itemArray() As Variant
  ReDim itemArray(0 To Dict.Count - 1)
  For Each Value In Dict.Keys
    itemArray(i) = Value
    i = i + 1
  Next

您可能不需要将字典转换为数组，因为您可以直接访问字典键值以进行进一步编码，这也会减少代码行。

在数组中获取“唯一”而不在工作表上过滤

2 个答案: