刪除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