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

时间:2015-11-20 18:23:54

标签: excel vba excel-vba listbox listboxitem

我正在重新设计子程序以从列表框中删除重复的行; " 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

1 个答案:

答案 0 :(得分:0)

尝试这种方法。

它的作用是将列表框的全部内容放到工作表上,使用“删除重复项”功能对其进行重复数据删除,然后将其重新加载到列表框中。

Dim ary As Variant

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