Как заполнить уникальные значения в выпадающий список?

Question

Я хочу заполнить уникальные значения в выпадающем списке.

Данные моего листа

Код:

Private Sub ComboBoxscname_DropButtonClick()
    With Worksheets("A1")
                ComboBoxscname.List = .Range("B2:B" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
    End With
End Sub

Я выделил желтым цветом, который продублирован для столбца "B" и должен отображаться только один раз в выпадающем списке.

Другое решение, которое я имею, но получаю ошибку при выборе указанных c название листа.

Sub ComboBoxscnameList()

Dim LR As Long
Dim ctrl As Object
'Set ctrl = Sheets("A1").Select

LR = Cells(Rows.Count, "B").End(xlUp).Row

ctrl.List() = CreateArray(Range("B2:B" & LR))

End Sub

'creates an array from a given range
'ignores blanks and duplicates

Function CreateArray(r As Range)
    Dim col As New Collection, c As Range, TempArray(), i As Long

    'for each cell in range r
    For Each c In r
        On Error Resume Next
        col.Add c.Value, CStr(c.Value)
        If Err.Number = 0 And Trim(c) <> "" Then
            ReDim Preserve TempArray(i)
            TempArray(i) = c.Value
            i = i + 1
        End If
        Err.Clear
    Next

    CreateArray = TempArray
    Erase TempArray

End Function

Private Sub ComboBoxscname_DropButtonClick()
Call ComboBoxscnameList            
End Sub

Answer 1

Самый простой способ сохранить уникальный набор значений из Column или Range - использовать Dictionary. Вы просматриваете ячейки в столбце B и проверяете, есть ли в каждой ячейке клавиши Dictionary, синтаксис: Dict.Exists("your_parameters").

. Подробнее об использовании Dictionary * 1009 можно прочитать подробнее. * ЗДЕСЬ .

Просмотрите приведенный ниже измененный код, вы хотите добавить его к своему событию UserForm_Initialize().

Измененный код

Private Sub UserForm_Initialize()


Dim i As Long, ArrIndex As Long, LastRow As Long
Dim Dict As Object, Key As Variant
Dim HSNArr() As String

Application.ScreenUpdating = False

' us a Dictionary, and save unique Eco-System as array
Set Dict = CreateObject("Scripting.Dictionary")

With ThisWorkbook.Worksheets("Sheet2") ' <-- modify to your sheet's name
    LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    ReDim HSNArr(1 To LastRow) ' redim HSN array >> will optimize size later
    ArrIndex = 1

    For i = 2 To LastRow
        If Not Dict.Exists(.Range("B" & i).Value2) And Trim(.Range("B" & i).Value2) <> "" Then  ' make sure not in Dictionary and ignore empty cells
            Dict.Add .Range("B" & i).Value2, .Range("B" & i).Value2 ' add current HSN
            HSNArr(ArrIndex) = .Range("B" & i).Value2
            ArrIndex = ArrIndex + 1
        End If
    Next i
End With
ReDim Preserve HSNArr(1 To ArrIndex - 1) ' resize to populated size of Array

Application.ScreenUpdating = True

With Me.ComboBoxscname
    .Clear ' clear previous combo-box contents
    For i = 1 To UBound(HSNArr) ' loop through array, add each unique HSN to Combo-Box
        .AddItem HSNArr(i)
    Next i

    ' show default value
    .Value = HSNArr(1)
End With

End Sub