Question

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

我知道如果我在Excel中排序并删除重复项，我就可以这样做...但是我希望在不改变Excel中的数据的情况下从VBA中删除它。

有可能吗？

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

我测试了代码排序并删除了组合框中的重复项。添加完所有项目后，它将在组合框列表中运行。可以使用范围或文件等来向组合框添加项目，以下仅是示例。主要部分是排序功能。有一点要记住，两个函数的对象参数都是通过引用传递的，所以在调用时不要使用这样的括号（当我这样做时，我得到了'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

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

Answer 4

与我的组合框配合正常，“现在您可以消除重复项：”

从VBA组合框中删除重复项

4 个答案: