删除重复行时子例程错误地删除剩余的列数据

Question

我正在重新设计一个子程序以从列表框中删除重复的行；列表框的“ColumnCount”属性设置为“13”。如果我不调用我的重复删除子例程，列表框将正确包含所有数据列；但是，有几行是重复的。子程序如下：

Private Sub RemoveDuplicateListBoxRows()
    Dim i As Long, j As Long
    Dim nodupes As New Collection
    Dim Swap1, Swap2, Item

    With Me.lbSrchMatchingResults

        For i = 0 To .ListCount - 1
            ' The next statement ignores the error caused
            ' by attempting to add a duplicate key to the collection.
            ' The duplicate is not added - which is just what we want!
            On Error Resume Next
            nodupes.Add .List(i), CStr(.List(i))
        Next i

    '   Resume normal error handling
        On Error GoTo 0

        'Clear the listbox
        .Clear

        'Sort the collection (optional)
        For i = 1 To nodupes.Count - 1
            For j = i + 1 To nodupes.Count
                If nodupes(i) > nodupes(j) Then
                    Swap1 = nodupes(i)
                    Swap2 = nodupes(j)
                    nodupes.Add Swap1, before:=j
                    nodupes.Add Swap2, before:=i
                    nodupes.Remove i + 1
                    nodupes.Remove j + 1
                End If
            Next j
        Next i

    '   Add the sorted and non-duplicated items to the ListBox
        For Each Item In nodupes
            .AddItem Item
        Next Item

    End With
End Sub

问题从以下代码行开始：

nodupes.Add .List(i), CStr(.List(i))

它只是将我的 13 列工作表的第一列添加到集合变量“nodupes”中。我想将工作表中的一整行添加到工作表中。如何修改我的集合以接受一整行数据，而不仅仅是一行的第一个单元格，以便在执行以下代码时正确重建列表框？

 For Each Item In nodupes
      .AddItem Item
 Next Item

Answer 1

试试这个方法。

它的作用是将列表框的全部内容拖放到工作表中，使用 Remove Duplicates 功能对其进行重复数据删除，然后将其加载回列表框。

作为变体的字典

ary = Me.lbSrchMatchingResults.List

With Worksheets("scratch")

    .UsedRange.ClearContents
    .Range("A1").Resize(UBound(ary, 1) - LBound(ary, 1) + 1, UBound(ary, 2) - LBound(ary, 2) + 1) = ary

    .UsedRange.RemoveDuplicates Columns:=Array(1)

    Me.lbSrchMatchingResults.List = .Range("A1").CurrentRegion.Value
End With