从 VBA 组合框中删除重复项

Remove duplicates from a VBA combobox

提问by Andrei Ion

Here's what I want to do... I have a big list of stuff in a sheet. I want to add all those (let's say are names) names to a VBA combobox but I want only unique records. I also want to sort them.

这就是我想要做的……我在一张纸上列出了一大堆东西。我想将所有这些（假设是名称）名称添加到 VBA 组合框，但我只想要唯一的记录。我也想对它们进行排序。

I know that I can do that if I sort and remove the duplicates in Excel... but I want to o it from VBA without altering the data in Excel.

我知道如果我对 Excel 中的重复项进行排序和删除，我可以做到这一点......但我想从 VBA 中删除它而不改变 Excel 中的数据。

Is it possible?

是否可以？

回答by DontFretBrett

Only add unqiue items:

只添加unqiue项目：

Sub addIfUnique(CB As ComboBox, value As String)
    If CB.ListCount = 0 Then GoTo doAdd
    Dim i As Integer
    For i = 0 To CB.ListCount - 1
        If LCase(CB.List(i)) = LCase(value) Then Exit Sub
    Next
doAdd:
    CB.AddItem value
End Sub

Found this code:

找到这个代码：

Sub SortCombo(oCb As MSForms.ComboBox)
    Dim vaItems As Variant
    Dim i As Long, j As Long
    Dim vTemp As Variant
    vaItems = oCb.List
    For i = LBound(vaItems, 1) To UBound(vaItems, 1) - 1
        For j = i + 1 To UBound(vaItems, 1)
            If vaItems(i, 0) > vaItems(j, 0) Then
                vTemp = vaItems(i, 0)
                vaItems(i, 0) = vaItems(j, 0)
                vaItems(j, 0) = vTemp
            End If
        Next j
    Next i
    oCb.Clear
    For i = LBound(vaItems, 1) To UBound(vaItems, 1)
        oCb.AddItem vaItems(i, 0)
    Next i
End Sub

回答by Andrei Ion

I have tested code sorting and removing duplicates in a combobox. It operates on combobox list after all items are added. Adding items to the combobox may be performed using range or file etc, below is just an example. The main part is the sorting function. One thing to remember, both functions' object arguments are passed by reference so when calling don't use brackets like so (I got 'Object Required' error when I did):

我已经在组合框中测试了代码排序和删除重复项。添加所有项目后，它对组合框列表进行操作。可以使用范围或文件等向组合框添加项目，以下只是一个示例。主要部分是排序功能。需要记住的一件事是，两个函数的对象参数都是通过引用传递的，因此在调用时不要使用像这样的括号（当我这样做时，我收到了“Object Required”错误）：

'example of calling function below    
GetItemsFromRange Worksheets(1).Range("A1:A20"), MyComboBox


'Build combobox list from range
Private Function GetItemsFromRange(ByRef inRange As Range, ByRef SampleBox As ComboBox) 
Dim currentcell As Range
For Each currentcell In inRange.Cells
If Not IsEmpty(currentcell.Value) Then
SampleBox.AddItem (Trim(currentcell.Value))
End If
Next currentcell
'call to sorting function, passing combobox by reference, 
'removed brackets due to 'Object Required' error
sortunique SampleBox  
End Function

Now this is our sorting function. I used Do-Loop statement because ListCount property may change value when duplicates are removed.

现在这是我们的排序功能。我使用 Do-Loop 语句是因为 ListCount 属性在删除重复项时可能会更改值。

Private Function sortunique(ByRef SampleBox As ComboBox)
Dim temp As Object 'helper item for swaps
Dim i As Long 'ascending index
Dim j As Long 'descending index
i = 0 'initialize i to first index in the list 

If SampleBox.ListCount > 1 Then 
'more than one item - start traversing up the list
Do
If SampleBox.List(i, 0) = SampleBox.List(i + 1, 0) Then 
'duplicate - remove current item
SampleBox.RemoveItem (i)
'item removed - go back one index    
i = i - 1 
ElseIf SampleBox.List(i, 0) > SampleBox.List(i + 1, 0) Then 
'if next item's value is higher then the current item's
temp = SampleBox.List(i, 0)
'then make a swap    
SampleBox.List(i, 0) = SampleBox.List(i + 1, 0)
SampleBox.List(i + 1, 0) = temp 
'and if index is more than 0
 If i > 0 Then 
 j = i
 Do  
 'start traversing down to check if our swapped item's value is lower or same as earlier item's
  If SampleBox.List(j - 1, 0) = SampleBox.List(j, 0) Then 
  'if duplicate found - remove it
  SampleBox.RemoveItem (j) 
  'update ascending index (it's decreased for all items above our index after deletion)
  i = i - 1
  'and continue on the way up
  Exit Do 
  ElseIf SampleBox.List(j - 1, 0) > SampleBox.List(j, 0) Then 
  'If item earlier in the list is higher than current
  temp = SampleBox.List(j, 0)
  'make a swap
  SampleBox.List(j, 0) = SampleBox.List(j - 1, 0)
  SampleBox.List(j - 1, 0) = temp 
  Else
  'When no lower value is found - exit loop
  Exit Do 
  End If 
 'update descending index
 j = j - 1 
 'continue if items still left below
 Loop While j > 0 
 End If
End If
'update ascending index
i = i + 1 
'continue if not end of list
Loop While i < SampleBox.ListCount - 1 
End If
End Function

回答by Juano

This can remove duplicates very easily, first load the combolist, as an axample:

这可以很容易地删除重复项，首先加载组合列表，例如：

'We fulfill the combolist with the selection, in this case using range
Dim rango, celda As Range
Set rango = Worksheets("ExampleWorksheet").Range("A1:A159")

For Each celda In rango
    Instrument.AddItem celda.Value
Next celda

And now you can eliminate the duplicates:

现在您可以消除重复项：

'Now we eliminate de duplicates in a single row
For i = 0 To Instrument.ListCount - 2
    For j = Me.Instrument.ListCount - 1 To i + 1 Step -1
        If Instrument.List(i) = Instrument.List(j) Then 'repeated
            Instrument.RemoveItem (j)
        End If
    Next j
Next i