从 VBA 组合框中删除重复项

Question

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

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

是否可以？

Answer 1

仅添加独特的项目：

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

找到此代码：

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

Answer 2

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

'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

现在这是我们的排序函数。我使用 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

Answer 3

这可以非常轻松地删除重复项，首先加载组合列表，例如：

'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

现在您可以消除重复项：

'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