从 VBA 组合框中删除重复项

Question

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

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

有可能吗？

Answer 1

只添加 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

找到这个代码：

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