VBA 唯一值答案

【问题标题】：VBA Unique valuesVBA 唯一值
【发布时间】：2019-12-01 16:40:15
【问题描述】：

我正在尝试在 A 列中查找所有唯一值，将唯一项复制到集合中，然后将唯一项粘贴到另一张表中。范围将是动态的。到目前为止，我得到了下面的代码，它无法将值复制到集合中，我知道问题出在定义 aFirstArray 上，因为在我尝试使其成为动态之前，该代码在创建集合时运行良好。

我在这做错了什么，因为项目不会进入集合，但代码只是运行到结束而没有循环。

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

【问题讨论】：

删除On Error Resume Next 看看你遇到了什么错误，然后相应地处理它们。就个人而言，我更喜欢使用脚本字典而不是集合。
问题似乎出在 arr.Add a，a 返回运行时错误 13: type mismatch。我的数据集是（A 列）是从 A2 开始的数字，所以我不明白问题是什么。
此参考可以帮助您使用字典方法实现目标。 stackoverflow.com/questions/45482245/…>
脚本字典的好处是它们有一个.Exists 方法。
@brax: 在向字典中添加元素时，你不需要.Exists，你可以写dict(key)= value，如果key不存在就会添加，见@987654322 @.

标签： excel vba unique-values

【解决方案1】：

你可以这样修复代码

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

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

更新：这就是您可以使用字典的方式。您需要添加对 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

【讨论】：

谢谢你这似乎现在可以工作了，所以我解释了 Cstr 把它变成了一个字符串，所以它可以被保存。您能帮我将值从对象复制到另一个位置吗？我不知道如何引用我们添加到对象的键。
如果这回答了您看起来的问题，请将答案标记为已接受。看看here如何处理收藏。如果您遇到问题，请打开一个新问题。
啊，对不起，我标记了它，谢谢你的链接！ :)
只是一个小评论，但您的第二个范围不是完全限定的，指的是活动工作表。
是的，对，我刚刚从 OP 复制了代码并修复了收集部分。添加了字典部分。我没有解决。关心范围。

【解决方案2】：

只是另一种选择，没有循环（尽管我也喜欢Dictionary）：

Sub Test()

Dim arr1 As Variant, arr2 As Variant

With Sheet1
    arr1 = .Range("A2", .Range("A2").End(xlDown))
    .Range("A2", .Range("A2").End(xlDown)).RemoveDuplicates Columns:=Array(1)
    arr2 = .Range("A2", .Range("A2").End(xlDown)).Value
    .Range("A2").Resize(UBound(arr1)).Value = arr1
End With

End Sub

您甚至不需要填充第二个数组，但您可以直接将值转移到您谈论的另一张表。无需使用唯一值填充任何数组/集合/字典，只要您存储原始值即可。

【讨论】：