Probleme de supression des doublement dans la liste de combobox 4

Function items_from_database_to_combobox()

Sheets("Fiche_contact_Fournisseurs").Activate

Dim LastRow As Long

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

ComboBox4.List = Range("B2:B" & LastRow).Value

End Function

bonjou,r

Function items_from_database_to_combobox()
     Dim Dict, aA, i
     Set Dict = CreateObject("scripting.dictionary")
     Dict.CompareMode = vbTextCompare

     With Sheets("Fiche_contact_Fournisseurs")
          aA = .Range(.Range("B2"), .Range("B" & Rows.Count).End(xlUp)).Value2
     End With

     For i = 1 To UBound(aA)
          Dict(aA(i, 1)) = vbEmpty
     Next

     ComboBox4.List = Dict.Keys
End Function

Salut le fil

Une petite fonction bien utile avec ici une collection :

' // PopulateListBox modifié par Jean-Paul (Valtrase) le : 08/04/2022
' // https://docs.microsoft.com/en-us/office/vba/excel/Concepts/Controls-DialogBoxes-Forms/add-a-unique-list-of-values-to-a-combo-box
' // Ajoute une liste de valeurs unique à un ComboBox ou ListBox d'un Formulaire personnel
Sub PopulateListBox(ByVal ctControl As String, ByVal rnData As Range, Usf As UserForm)
    Dim vaData As Variant               ' La liste de valeur stockée dans un variant
    Dim ncData As New VBA.Collection    ' Collection pour stoker les valeurs unique
    Dim lnCount As Long                 ' Compteur utilisé dans la boucle On Error Resume Next loop.
    Dim vaItem As Variant               ' Elément variant de valeur unique dans  la collection ncData
    ' // Place les valeurs de la plage dans vaData
    vaData = rnData.Value

    ' // Place les valeurs de liste de vaData dans la Collection.
    On Error Resume Next
    For lnCount = 1 To UBound(vaData)
        ncData.Add vaData(lnCount, 1), CStr(vaData(lnCount, 1))
    Next lnCount
    On Error GoTo 0

    ' // Efface la zone de liste déroulante (au cas où vous auriez déjà exécuté la macro),
    'puis ajoute chaque élément unique de ncData à la zone de liste déroulante.
    With Usf.Controls(ctControl)
        .Clear
        For Each vaItem In ncData
            .AddItem ncData(vaItem)
        Next vaItem
    End With
End Sub

et pour l'appel si l'on a un tableau structuré qui se nomme t_Fournisseurs avec une colonne Nom

Private Sub UserForm_Initialize()
    PopulateListBox "lsbSearchResult", Range("t_Fournisseurs[Nom]"), Me
End Sub

La procédure ne prends pas en charge le tri, donc pour de bons résultats le tableau structuré doit être trié.

Rechercher des sujets similaires à "probleme supression doublement liste combobox"