Const MA_BASE As String = "Sheet1" 'à adapter du nom de la feuille de la base de données
Dim var
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim T()
Dim i&
Dim cpt&
For i& = 1 To UBound(var)
If var(i&, 1) = ListBox1 Then
cpt& = cpt& + 1
ReDim Preserve T(1 To cpt&)
T(cpt&) = var(i&, 2)
End If
Next i&
Me.ListBox2.List = T
End Sub
Private Sub UserForm_Initialize()
Dim S As Worksheet
Dim R As Range
Dim i&
Dim DICO As Object
Dim T()
Set S = Sheets(MA_BASE)
Set R = S.[A1].CurrentRegion
var = R.Offset(1, 0).Resize(R.Rows.Count - 1, R.Columns.Count)
Set DICO = CreateObject("Scripting.Dictionary")
For i& = 1 To UBound(var, 1)
If Not DICO.Exists(var(i&, 1)) Then
DICO.Add var(i&, 1), var(i&, 1)
ReDim Preserve T(1 To DICO.Count)
T(DICO.Count) = var(i&, 1)
End If
Next i&
Call algoTri(LBound(T), UBound(T), T)
Me.ListBox1.List() = T
End Sub
'**************************
Private Sub algoTri(ByVal limiteinf As Integer, ByVal limitesup As Integer, ByRef tabtri() As Variant)
Dim i%
Dim j%
Dim element
Dim transit
i% = limiteinf
j% = limitesup
transit = tabtri((limiteinf + limitesup) \ 2)
Do
Do While tabtri(i%) < transit
i% = i% + 1
Loop
Do While transit < tabtri(j%)
j% = j% - 1
Loop
If i% <= j% Then
element = tabtri(i%)
tabtri(i%) = tabtri(j%)
tabtri(j%) = element
i% = i% + 1
j% = j% - 1
End If
Loop Until i% > j%
If limiteinf < j% Then
Call algoTri(limiteinf, j%, tabtri())
End If
If i% < limitesup Then
Call algoTri(i%, limitesup, tabtri())
End If
End Sub