Удалить дубликаты из выпадающего списка 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