2016-08-24 122 views
1

我想從另一個工作表中添加重複名稱的列表。在列表框中,我想要具有唯一的名稱,而不是重複的名稱。下面的代碼沒有對它們進行重複排序,它出錯了。任何幫助表示讚賞。VBA刪除列表框重複

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

路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

創建一個獨特的集合,然後將其添加到列表框中

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 
+0

我做了Way 1,僅僅是因爲我想爲其他語句使用該數據。它說「無效的屬性數組索引」 – Rosario

+0

我添加了兩個更改。請現在試試。 –

0
Private Sub Workbook_Open() 
Dim ctrlListNames As MSForms.ListBox 
Dim i As Long 
Dim j As Long 

ctrlListNames.List = Application.ThisWorkbook.Worksheets("Names").Range("Salesperson").Value 


With ctrlListNames 
For i = 0 To .ListCount - 1 
    For j = .ListCount To (i + 1) Step -1 
     If .List(j) = .List(i) Then 
      .RemoveItem j 
     End If 
    Next 
Next 
End With 


End Sub 

它說無效的屬性數組索引。