Création de liste dans une combobox

Version imprimable

Bonjour,

Dans un classeur, j’ai deux colonnes de données. Dans la première figurent une liste de noms, qui peuvent apparaître plusieurs fois chacun. Dans le seconde colonne, on retrouve des initiales correspondant à chaque entrée de la première colonne. Dans la première colonne, un nom apparaît plusieurs fois uniquement si plusieurs initiales lui sont affectées.
Via deux combobox, je cherche à générer deux listes « uniques »(dans le sens ou pas de doublons présents), la deuxième dépendant directement de la sélection faite dans la première. Concrètement, si dans cette première liste un nom est choisi, la seconde combobox donnant le choix des initiales, ne doit comporter que les initiales qui ne lui ont pas déjà été affectées.

Exemple :
John AAA
Bart BBB
Bart AAA
Jean CCC

Si John est sélectionné dans la combobox1, alors seuls BBB et CCC devront apparaître dans la combobox2.
Si Bart est sélectionné dans la combobox1, alors seul CCC devra apparaître dans la combobox2.
Si Jean est sélectionné dans la combobox1, alors seuls BBB et AAA devront apparaître dans la combobox2.

J'ai pour le moment mis ceci :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Private Sub ComboBox1_Change() ComboBox2.Clear Dim ListeUniqueComboBox2 As New Collection On Error Resume Next For Each cell In Worksheets("Feuil1").Range("I11:I" & Worksheets("Feuil1").Range("I11").End(xlDown).Row) If cell <> Application.WorksheetFunction.VLookup(ComboBox1.Text, Sheets("Feuil1").Range("G11:I" & Worksheets("Feuil1").Range("G11").End(xlDown).Row), 3, False) Then ListeUniqueComboBox2.Add cell, CStr(cell) End If Next cell On Error GoTo 0 For i = 1 To ListeUniqueComboBox2.Count ComboBox2.AddItem ListeUniqueComboBox2.Item(i) Next i End Sub
Seulement, ce code ne prend pas en compte le fait qu'un nom peut avoir plusieurs initiales qui lui ont été affectés... Savez-vous comment pallier le problème ?

Merci d'avance.

Bonsoir
Une proposition (j'ai utilisé un dictionnaire en cochant la référence Microsoft Scripting Runtime

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
'Cocher la référence: Microsoft Scripting Runtime
 
Private Sub UserForm_Initialize()
Dim Lastlig As Long, i As Long
Dim MonDico As New Scripting.Dictionary
Dim Tb
 
With Worksheets("Feuil1")
    Lastlig = .Cells(.Rows.Count, "G").End(xlUp).Row
    Tb = .Range("G11:G" & Lastlig).Value
End With
 
For i = 1 To UBound(Tb, 1)
    If Not MonDico.Exists(Tb(i, 1)) Then MonDico.Add Tb(i, 1), Tb(i, 1)
Next i
 
If MonDico.Count > 0 Then
    For i = 0 To MonDico.Count - 1
        Me.ComboBox1.AddItem MonDico.Items(i)
    Next i
End If
Set MonDico = Nothing
End Sub
 
Private Sub ComboBox1_Change()
Dim Nom As String, Sans As String, Avec As String
Dim Lastlig As Long, i As Long
Dim MonDico As New Scripting.Dictionary
Dim Tb
 
 
Me.ComboBox2.Clear
If Me.ComboBox1.ListIndex > -1 Then
    Nom = Me.ComboBox1.Value
    With Worksheets("Feuil1")
        Lastlig = .Cells(.Rows.Count, "G").End(xlUp).Row
        Tb = .Range("G11:I" & Lastlig).Value
    End With
 
    For i = 1 To UBound(Tb, 1)
        If Tb(i, 1) <> Nom Then
            Sans = Sans & "|" & Tb(i, 3)
        Else
            Avec = Avec & "|" & Tb(i, 3)
        End If
    Next i
 
    Tb = Split(Sans, "|")
    For i = LBound(Tb) To UBound(Tb)
        If InStr(Avec, Tb(i)) = 0 Then
            If Not MonDico.Exists(Tb(i)) Then MonDico.Add Tb(i), Tb(i)
        End If
    Next i
 
    If MonDico.Count > 0 Then
        For i = 0 To MonDico.Count - 1
            Me.ComboBox2.AddItem MonDico.Items(i)
        Next i
    End If
    Set MonDico = Nothing
End If
End Sub

27/03/2012, 01h27
m@tix

Bonsoir mercatog !

Merci beaucoup pour ton aide, ton code semble très bien fonctionner ! :ccool:
Cependant, pourrais-tu m'expliquer l'utilité de la référence Microsoft Scripting Runtime ? Pourquoi utiliser un dictionnaire ?

J'ai utilisé un dictionnaire mais tu peux toujours utiliser une collection à la place.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
Private Sub UserForm_Initialize()
Dim Lastlig As Long, i As Long
Dim Kol As New Collection
Dim Tb
 
With Worksheets("Feuil1")
    Lastlig = .Cells(.Rows.Count, "G").End(xlUp).Row
    Tb = .Range("G11:G" & Lastlig).Value
End With
 
For i = 1 To UBound(Tb, 1)
    On Error Resume Next
    Kol.Add Tb(i, 1), Tb(i, 1)
    On Error GoTo 0
Next i
 
If Kol.Count > 0 Then
    For i = 1 To Kol.Count
        Me.ComboBox1.AddItem Kol(i)
    Next i
End If
Set Kol = Nothing
End Sub
 
Private Sub ComboBox1_Change()
Dim Nom As String, Sans As String, Avec As String
Dim Lastlig As Long, i As Long
Dim Kol As New Collection
Dim Tb
 
Me.ComboBox2.Clear
If Me.ComboBox1.ListIndex > -1 Then
    Nom = Me.ComboBox1.Value
    With Worksheets("Feuil1")
        Lastlig = .Cells(.Rows.Count, "G").End(xlUp).Row
        Tb = .Range("G11:I" & Lastlig).Value
    End With
 
    For i = 1 To UBound(Tb, 1)
        If Tb(i, 1) <> Nom Then
            Sans = Sans & "|" & Tb(i, 3)
        Else
            Avec = Avec & "|" & Tb(i, 3)
        End If
    Next i
 
    Tb = Split(Sans, "|")
    For i = LBound(Tb) To UBound(Tb)
        If InStr(Avec, Tb(i)) = 0 Then
            On Error Resume Next
            Kol.Add Tb(i), Tb(i)
            On Error GoTo 0
        End If
    Next i
 
    If Kol.Count > 0 Then
        For i = 1 To Kol.Count
            Me.ComboBox2.AddItem Kol(i)
        Next i
    End If
End If
Set Kol = Nothing
End Sub

29/03/2012, 01h27
m@tix

Ok, merci pour les explications. Je ne connaissais pas les collections non plus..

Bonne nuit ! :)
29/03/2012, 11h40
mercatog

Citation:

Je ne connaissais pas les collections non plus..

Pourtant tu les as utilisé dans ton code #1

Citation:

Code:

Dim ListeUniqueComboBox2 As New Collection
31/03/2012, 21h21
m@tix

Autant pour moi, la fatigue devait commencer à se faire ressentir.. :roll: