VBA唯一值 [英] VBA Unique values

问题描述

我试图在A列中找到所有唯一值，然后将唯一项复制到集合中，然后将唯一项粘贴到另一张纸上.该范围将是动态的.到目前为止，我有下面的代码，它无法将值复制到集合中，我知道问题出在定义 aFirstArray 上，因为在尝试创建集合之前，代码可以很好地完成集合的工作它是动态的.

I'm trying to find all unique values in column A copy the unique items to a collection and then paste the unique items to another sheet. The range will be dynamic. So far I've got the code below, it fails to copy the values to a collection and I know the issue is in defining the aFirstArray because the code worked fine in making a collection before I tried to make it dynamic.

在这方面我做错了什么，因为这些项不会归入一个集合，但是代码运行到最后而没有循环.

What am I doing wrong in this because the items are not going to a collection, but the code just runs to end without looping.

Sub unique()

Dim arr As New Collection, a
Dim aFirstArray() As Variant
Dim i As Long

aFirstArray() = Array(Worksheets("Sheet1").Range("A2", Range("A2").End(xlDown)))

On Error Resume Next
For Each a In aFirstArray
    arr.Add a, a
Next

For i = 1 To arr.Count
    Cells(i, 1) = arr(i)
Next

End Sub

推荐答案

您可以修复这样的代码

Sub unique()
    Dim arr As New Collection, a
    Dim aFirstArray As Variant
    Dim i As Long

    aFirstArray = Worksheets("Sheet1").Range("A2", Range("A2").End(xlDown))

    On Error Resume Next
    For Each a In aFirstArray
        arr.Add a, CStr(a)
    Next
    On Error GoTo 0

    For i = 1 To arr.Count
        Cells(i, 2) = arr(i)
    Next

End Sub

代码失败的原因是键必须是唯一的字符串表达式，请参见

The reason for your code failing is that a key must be a unique string expression, see MSDN

更新:这就是使用字典的方法.您需要将引用添加到Microsoft脚本运行时(工具/参考):

Update: This is how you could do it with a dictionary. You need to add the reference to the Microsoft Scripting Runtime (Tools/References):

Sub uniqueA()
    Dim arr As New Dictionary, a
    Dim aFirstArray As Variant
    Dim i As Long

    aFirstArray = Worksheets("Sheet1").Range("A2", Range("A2").End(xlDown))

    For Each a In aFirstArray
        arr(a) = a
    Next

    Range("B1").Resize(arr.Count) = WorksheetFunction.Transpose(arr.Keys)

End Sub

这篇关于VBA唯一值的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！