VBA删除列表框重复项 [英] VBA Removing ListBox Duplicates

问题描述

我正在尝试从另一个重复的工作表中添加名称列表.在列表框上，我希望有唯一的名称，而不是重复的名称.以下代码未对重复项进行排序，因此会出错.感谢您的帮助.

I'm trying to add a list of names from another worksheet that has duplicates. On the listbox, I want to have unique names, instead of duplicates. The following code is not sorting them for duplicates, it errors out. Any help is appreciated.

Dim intCount As Integer
Dim rngData As Range
Dim strID As String
Dim rngCell As Range
dim ctrlListNames as MSForms.ListBox
Set rngData = Application.ThisWorkbook.Worksheets("Names").Range("A").CurrentRegion

'declare header of strID and sort it
strID = "Salesperson"
rngData.Sort key1:=strID, Header:=xlYes
'Loop to add the salesperson name and to make sure no duplicates are added
For Each rngCell In rngData.Columns(2).Cells
    If rngCell.Value <> strID Then
        ctrlListNames.AddItem rngCell.Value
        strID = rngCell.Value
    End If
Next rngCell

推荐答案

方法1

使用它删除重复项

Sub Sample()
    RemovelstDuplicates ctrlListNames
End Sub

Public Sub RemovelstDuplicates(lst As msforms.ListBox)
    Dim i As Long, j As Long
    With lst
        For i = 0 To .ListCount - 1
            For j = .ListCount - 1 To (i + 1) Step -1
                If .List(j) = .List(i) Then
                    .RemoveItem j
                End If
            Next
        Next
    End With
End Sub

方法2

创建一个唯一的集合，然后将其添加到列表框中

Create a unique collection and then add it to the listbox

Dim Col As New Collection, itm As Variant

For Each rngCell In rngData.Columns(2).Cells
    On Error Resume Next
    Col.Add rngCell.Value, CStr(rngCell.Value)
    On Error GoTo 0
Next rngCell

For Each itm In Col
    ctrlListNames.AddItem itm
Next itm

这篇关于VBA删除列表框重复项的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！