0

我有一个问题。我正在尝试将所有唯一值（数字和字母数字）从动态工作表复制到另一个工作表。我在一个论坛上找到了一个很棒的脚本，它运行迅速并且已经适应了它。问题是它似乎过滤掉了所有数值，而我这辈子看不到为什么！？！你能帮我吗？

    Sub GetUniqueItems()
    Dim vData As Variant, n&, lLastRow&, sMsg$

    lLastRow = Worksheets(Worksheets("Summary").Range("A1").Value)._
    Cells(Rows.Count, "H").End(xlUp).Row
    If lLastRow = 1 Then Exit Sub '//no data

    vData = Worksheets(Worksheets("Summary").Range("A1").Value)._
    Range("H2:H" & lLastRow)
    Dim oColl As New Collection
    On Error Resume Next
    For n = LBound(vData) To UBound(vData)
    oColl.Add vData(n, 1), vData(n, 1)
    Next 'n

    For n = 1 To oColl.Count
    sMsg = oColl(n)
    Sheets("Summary").Cells(n + 3, 1).Value = Mid$(sMsg, 1)
    Next 'n

    End Sub
4

2 回答 2

2

项目的键Collection必须是字符串。所以改变这一行：

oColl.Add vData(n, 1), vData(n, 1)

对此：

oColl.Add vData(n, 1), CStr(vData(n, 1))

此外，尽管您需要，On Error Resume Next因此代码将跳过任何尝试将重复项添加到集合中，但您应该只将它用于那一行。否则，您可能会掩盖代码中的其他错误。（您的代码没有运行时错误的原因是On Error Resume Next，除了完成绕过重复项的工作外，还跳过了Adds带有 numeric的任何内容Keys。

出于这个原因，我将这一行移到了之前oColl.Add并在之后添加On Error Goto 0了：

这是完整的例程：

Sub GetUniqueItems()
Dim vData As Variant, n&, lLastRow&, sMsg$
Dim oColl As Collection

lLastRow = Worksheets(Worksheets("Summary").Range("A1").Value).Cells(Rows.Count, "H").End(xlUp).Row
If lLastRow = 1 Then Exit Sub

vData = Worksheets(Worksheets("Summary").Range("A1").Value).Range("H2:H" & lLastRow)
Set oColl = New Collection
For n = LBound(vData) To UBound(vData)
    On Error Resume Next
    oColl.Add vData(n, 1), CStr(vData(n, 1))
    On Error GoTo 0
Next n

For n = 1 To oColl.Count
    sMsg = oColl(n)
    Sheets("Summary").Cells(n + 3, 1).Value = Mid$(sMsg, 1)
Next n
End Sub

最后一件事：您想避免像Dim oColl As New Collection, 这样的语句，而是像我一样分两步声明和设置它。原因请参见Chip Pearson 页面并向下滚动到“不要使用自动实例化对象变量”。

于 2013-06-30T14:42:24.970 回答
1

我正在显示下面的代码，因为它可能对 OP 或其他人感兴趣，并且是从数据列中获取唯一列表的有效方法。

在 Excel 2007 或更高版本中，我们可以复制该列并利用该Remove Duplicates功能来获取我们的唯一列表。

Sub CreateUniqueList()
    Dim lLastRow As Long
    Dim wsSum As Worksheet
    Dim rng As Range

    Set wsSum = Worksheets("Summary")
    lLastRow = wsSum.Cells(Rows.Count, "H").End(xlUp).Row
    If lLastRow = 1 Then Exit Sub

    wsSum.Range("H2:H" & lLastRow).Copy wsSum.Cells(4, 1)
    wsSum.Range(wsSum.Cells(4, 1), wsSum.Cells(4 + lLastRow - 2, 1)). _
        RemoveDuplicates Columns:=1, Header:=xlNo
End Sub

唯一的小缺点是我们首先必须复制整个列，但这与大量数据的性能提升相比是微不足道的。

于 2013-06-30T16:34:41.273 回答