在阵列获取“独特的”而不对片

过滤我提取从列唯一值，并把它们在阵列中与这样的代码：在阵列获取“独特的”而不对片

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

的问题是：有可能把它们直接放入数组？

我的意思是用一个命令或用最少的代码（我知道我可以通过与他人的每一项比较得到的唯一值）

在此先感谢

来源

2015-02-09 genespos

我不知道有一种方法来initalise和充满蝙蝠唯一值的数组，但你可以使用字典来建立独特的条目

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

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

来源

2015-02-09 22:53:49 Tragamor

谢谢，它的工作原理，它似乎非常快，但是当我在宏中运行它时，快速？ – genespos 2015-02-10 10:21:07

这将让列独特的文本项目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

来源

2015-02-09 18:15:49 Davesexcel

我跑了它，但“上校”不会从选定的范围中取任何值（没有显示错误） – genespos 2015-02-10 09:52:54

在阵列获取“独特的”而不对片

回答

相关问题