Combobox

Sub Unique_Sorted_ComboList(CbList As msforms.ComboBox, rg As Range)
    Dim Dict
    Dim c As Range
    Dim i As Long, j As Long
    Dim arrList As Variant, vTemp As Variant
    Dim mots, s As String
    
    'Créer une liste des valeurs unique avec un dictionnaire
    Set Dict = CreateObject("Scripting.Dictionary")
    Dict.CompareMode = vbTextCompare
    For Each c In rg
        If Not IsEmpty(c.Value) And Not Dict.exists(c.Value) Then
            mots = Split(c.Value): s = mots(UBound(mots))
            ReDim Preserve mots(UBound(mots) - 1)
            s = Join(mots) & String(10 - Len(s), "0") & s
            Dict.Add s, c.Value
        End If
    Next c
    
    'Trier la liste
    arrList = Dict.keys
    For i = LBound(arrList) To UBound(arrList) - 1
        For j = i + 1 To UBound(arrList, 1)
            If arrList(i) > arrList(j) Then
                vTemp = arrList(i)
                arrList(i) = arrList(j)
                arrList(j) = vTemp
            End If
        Next j
    Next i
    
    'Remplir la combobox avec des valeurs unique triées
    CbList.Clear
    For i = 0 To Dict.Count - 1
       CbList.AddItem Dict(arrList(i))
    Next i
End Sub

 Dim c As Range  et  Dim rg As Range

Private Sub UserForm_Initialize()

Dim c As Range
Dim tablo()
Dim i As Integer, j As Integer
Dim temp As String
Dim present As Boolean

ReDim tablo(1 To 1)
tablo(1) = Cells(1, 1)
For Each c In Sheets("Feuil1").Range("A1:A" & Range("a65536").End(xlUp).Row)
    present = False
    For i = 1 To UBound(tablo)
        If tablo(i) = c Then present = True
    Next i
    If Not present Then
        ReDim Preserve tablo(1 To UBound(tablo) + 1)
        tablo(UBound(tablo)) = c
    End If
    For i = 1 To UBound(tablo)
        For j = 1 To UBound(tablo)
            If tablo(i) < tablo(j) Then
                temp = tablo(i)
                tablo(i) = tablo(j)
                tablo(j) = temp
            End If
        Next j
    Next i
Next c

ListBox1.List = tablo


    Dim rg As Range
 

    Set rg = Feuil2.Range("C3:C" & Feuil2.Range("C" & Rows.Count).End(xlUp).Row)
    Unique_Sorted_ComboList Me.ComboBox1, rg

End Sub

Sub TrierComboBox(ctrlComboBox As Control)
Dim dico As New Scripting.Dictionary, tablo, mots
Dim ech As Boolean, aux, i As Long, s

  For i = 0 To ctrlComboBox.ListCount - 1
    mots = Split(ctrlComboBox.List(i)): s = String(10 - Len(mots(UBound(mots))), "0") & mots(UBound(mots))
    If Not dico.Exists(s) Then dico.Add s, ctrlComboBox.List(i)
  Next i
  
  tablo = dico.Keys
  Do
    ech = False
    For i = 0 To dico.Count - 2
      If tablo(i) > tablo(i + 1) Then
        aux = tablo(i): tablo(i) = tablo(i + 1): tablo(i + 1) = aux
        ech = True
      End If
    Next i
  Loop Until Not ech
  
  ctrlComboBox.Clear
  For i = 0 To dico.Count - 1
    ctrlComboBox.AddItem dico(tablo(i))
  Next i
End Sub