Liste déroulante selon critère

**bidochon34800** · 23/04/2013, 08h01

Bonjour, je cherche (en vain) à créer à partir d'une liste déroulante, la possibilité d'ouvrir une seconde liste de choix avec validation. Je m'explique : j'ai des références/produits dans une liste déroulante, et je voudrais à partir de cette réf. m'ouvrir une autre liste de produits en fonction. A noter qu'une réf. peut correspondre à plusieurs produits en fonction d'autres critères.
Merci

**jijie** · 23/04/2013, 09h07

Bonjour,

Dans ce cas, j'ai crée un module qui reste à adapter!

ici avec deux listbox

Dans la colonne Q j'ai toutes les sections et dans la colonne i les analytiques donc je m'exprime: une section Cuisine avec analytiques Fourniture repas, Personnel.....

Donc dés lors que Cuisine est sélectionner dans la listebox5 alors on trouveras les analytiques correspondant ds la listbox3 et sans doublons et ainsi de suite pour d'autres analytiques sélectionner.....

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Option Explicit
 
Dim strSeCtion As String
 
Sub AnalYse()
 
Dim i As Long
Dim c As Long
Dim y As Long
Dim ColSeCtion As New Collection
Dim colAnalYtique As New Collection
 
ListBox3.Clear
 
     For y = 0 To ListBox5.ListCount - 1
 
 
 
If ListBox5.Selected(y) = True Then '*
 
If ListBox5.List(y) <> "" And ListBox5.List(y) <> strSeCtion Then
    strSeCtion = ListBox5.List(y)
End If
 
 
 
 
i = 2
 
Do While ThisWorkbook.Worksheets("Récap_cptes").Range("Q" & i).Value <> ""
    On Error Resume Next
 
    ColSeCtion.Add ThisWorkbook.Worksheets("Récap_cptes").Range("Q" & i).Value, CStr(ThisWorkbook.Worksheets("Récap_cptes").Range("Q" & i).Value)
 
    If strSeCtion = "" Or ThisWorkbook.Worksheets("Récap_cptes").Range("Q" & i).Value = strSeCtion Then
        colAnalYtique.Add ThisWorkbook.Worksheets("Récap_cptes").Range("E" & i).Value, CStr(ThisWorkbook.Worksheets("Récap_cptes").Range("E" & i).Value)
    End If
 
 
 
    i = i + 1
Loop
 
 
 
 End If
 Next y
For c = 1 To colAnalYtique.Count
    ListBox3.AddItem colAnalYtique(c)
Next c
end sub

**bidochon34800** · 23/04/2013, 20h11

merci beaucoup de la réponse, mais j'ai pas réussi à l'adapter à mon cas. Peux-tu être + clair ? en attendant je vais encore essayer de comprendre.
Merci toutefois.

**jijie** · 23/04/2013, 20h50

Re

Tu ne comprends pas quoi?
Et tu souhaite faire quoi ? soit plus claire!!

Cordialement,

**bidochon34800** · 24/04/2013, 05h52

Je souhaite avoir une liste déroulante où s'affichent des produits. Chacun de ces produits m'ouvrirait une autre liste déroulante avec les références/spécifications. (ex: j'ai des salades et des radis en liste1, en cliquant sur "salade", celà m'ouvrirait une liste2 avec toutes les variétés de salades disponibles.

**jijie** · 24/04/2013, 08h47

Bonjour,

tout d'abord ds mon exemple les listbox en propriété sont en fmMultiSelectMulti, car cela te permet de sélectionner plusieurs familles et de trouver ds la liste suivante les variétés de chaque familles!

donc si en A tu as la famille (radis) et B les variétés then tu créé 2 listbox sur un userform

ds initialize dans l'user on charge les familles existantes dans la liste sans doublon:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
Private Sub UserForm_Initialize()
 
Dim MonDico As Object, Cellule As Range
 
  Set MonDico = CreateObject("Scripting.Dictionary")
      For Each Cellule In Sheets("feuil1").Range("a2:a60000")
      If Not MonDico.Exists(Cellule.Value) Then MonDico.Add Cellule.Value, Cellule.Value
      Next Cellule
        ListBox1.List = MonDico.Items
        MonDico.RemoveAll
end sub

et tu colle ds un module :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Option Explicit
 
Dim strSeCtion As String
 
Sub AnalYse()
 
Dim i As Long
Dim c As Long
Dim y As Long
Dim ColSeCtion As New Collection
Dim colAnalYtique As New Collection
 
'ListBox2.Clear
 
     For y = 0 To ListBox1.ListCount - 1
 
 
 
If ListBox1.Selected(y) = True Then '*
 
If ListBox1.List(y) <> "" And ListBox1.List(y) <> strSeCtion Then
    strSeCtion = ListBox1.List(y)
End If
 
 
 
 
i = 2
 
Do While ThisWorkbook.Worksheets("Feuil1").Range("a" & i).Value <> ""
    On Error Resume Next
 
    ColSeCtion.Add ThisWorkbook.Worksheets("Feuil1").Range("a" & i).Value, CStr(ThisWorkbook.Worksheets("Feuil1").Range("a" & i).Value)
 
    If strSeCtion = "" Or ThisWorkbook.Worksheets("Feuil1").Range("a" & i).Value = strSeCtion Then
        colAnalYtique.Add ThisWorkbook.Worksheets("Feuil1").Range("b" & i).Value, CStr(ThisWorkbook.Worksheets("Feuil1").Range("b" & i).Value)
    End If
 
 
 
    i = i + 1
Loop
 
 
 
 End If
 Next y
For c = 1 To colAnalYtique.Count
    ListBox2.AddItem colAnalYtique(c)
Next c
end sub

puis sur ta listbox1 ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
 AnalYse
 
end sub

Voici comment je fait, bon si un blogueur peu confirmer mon montage il sera le bienvenu, mais, même si je l'adapte à main levé ça doit fonctionner!

Cordialement,

**bidochon34800** · 24/04/2013, 18h35

OK merci, je vais essayer de me dépatouiller avec ça. Je ne promets pas d'y arriver mais je vais essayer.
Merci encore

J'ai (je pense ???) tout fait comme tu m'as dit. Apparemment çà bugge au départ. Je te joins une capture d'écran pour te montrer le problème.

**SfJ5Rpw8** · 24/04/2013, 18h43

bonjour,

plutôt qu'une copie d'écran illisible dis-nous ce qui se passe , message d'erreur ? sur qu'elle ligne ? ..

**bidochon34800** · 24/04/2013, 19h50

c'est dans analyse,
il y a
For y = 0 To ListBox1.ListCount - 1 qui se souligne en jaune
par contre je précise que ma liste à afficher se trouve en colonne B, j'ai adapté en conséquence, est ce que ça pourrait venir de là ?

**jijie** · 24/04/2013, 20h06

Bonjour à ts les deux,

Ds l'exemple que je t'ais donné les familles en colonne a et les variétés en colonne B c'est ça ??

Et tu as bien mis deux listbox?

sinon je regarde ça soir plus tard?

jijie

**bidochon34800** · 25/04/2013, 07h51

merci du coup de mamin

**jijie** · 25/04/2013, 09h48

Bonjour,

Donc dans le module j'avais oublié de nommer l'User

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
 
Dim strSeCtion As String
 
Sub AnalYse()
 
Dim i As Long
Dim c As Long
Dim y As Long
Dim ColSeCtion As New Collection
Dim colAnalYtique As New Collection
 
UserForm1.ListBox2.Clear
 
     For y = 0 To UserForm1.ListBox1.ListCount - 1
 
 
 
If UserForm1.ListBox1.Selected(y) = True Then '*
 
If UserForm1.ListBox1.List(y) <> "" And UserForm1.ListBox1.List(y) <> strSeCtion Then
    strSeCtion = UserForm1.ListBox1.List(y)
End If
 
 
 
 
i = 2
 
Do While ThisWorkbook.Worksheets("Feuil1").Range("a" & i).Value <> ""
    On Error Resume Next
 
    ColSeCtion.Add ThisWorkbook.Worksheets("Feuil1").Range("a" & i).Value, CStr(ThisWorkbook.Worksheets("Feuil1").Range("a" & i).Value)
 
    If strSeCtion = "" Or ThisWorkbook.Worksheets("Feuil1").Range("a" & i).Value = strSeCtion Then
        colAnalYtique.Add ThisWorkbook.Worksheets("Feuil1").Range("b" & i).Value, CStr(ThisWorkbook.Worksheets("Feuil1").Range("b" & i).Value)
    End If
 
 
 
    i = i + 1
Loop
 
 
 
 End If
 Next y
For c = 1 To colAnalYtique.Count
    UserForm1.ListBox2.AddItem colAnalYtique(c)
Next c
End Sub

Donc colle ce code à la place de l’ancien et merci de me tenir au courant !

Cordialement,

**bidochon34800** · 25/04/2013, 17h20

bonjour, ça ne marche toujours pas. Rien ne s'affiche dans l'Userform. J'ai bien
mes deux listbox dans l'UF, j'ai ma colonne produits en "A" et mes spécialités en "B". J'ai adapté ton code avec mes noms de feuilles, etc etc mais ça ne marche pas ?

**jijie** · 25/04/2013, 22h36

Bonsoir,

j'ai ma colonne produits en "A" et mes spécialités en "B". J'ai adapté ton code avec mes noms de feuilles, etc etc mais ça ne marche pas ?

Tu as plusieurs feuilles?
Bon regarde en PJ

**bidochon34800** · 26/04/2013, 06h24

super, ça marche (mais pas du premier coup).
En fait, ça venait que j'avais 3 lignes vides au dessus de mon tableau ( la liste de produits ne commençait qu'en ligne 4. Je les ai virées et ça fonctionne....
Par contre, si je veux ajouter une ou deux colonnes dans l'userform pour spécifications de poids et de prix par exemple, je n'ai plus qu'à adapter, ai-je tout compris ?)
En tous cas, merci infiniment

**jijie** · 26/04/2013, 18h35

Voici en Modifie le module :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
64
65
66
67
68
69
70
 
Option Explicit
 
Dim strSeCtion As String
 
Sub AnalYse()
 
Dim i As Long
Dim c As Long
Dim y As Long
Dim K As Long
Dim ColSeCtion As New Collection
Dim colAnalYtique As New Collection
Dim colQté As New Collection
Dim colPrix As New Collection
 
UserForm1.ListBox2.Clear
 
     For y = 0 To UserForm1.ListBox1.ListCount - 1
 
 
 
If UserForm1.ListBox1.Selected(y) = True Then '*
 
If UserForm1.ListBox1.List(y) <> "" And UserForm1.ListBox1.List(y) <> strSeCtion Then
    strSeCtion = UserForm1.ListBox1.List(y)
End If
 
 
 
 
i = 2
 
Do While ThisWorkbook.Worksheets("Feuil1").Range("a" & i).Value <> ""
    On Error Resume Next
 
    ColSeCtion.Add ThisWorkbook.Worksheets("Feuil1").Range("a" & i).Value, CStr(ThisWorkbook.Worksheets("Feuil1").Range("a" & i).Value)
 
    If strSeCtion = "" Or ThisWorkbook.Worksheets("Feuil1").Range("a" & i).Value = strSeCtion Then
        colAnalYtique.Add ThisWorkbook.Worksheets("Feuil1").Range("b" & i).Value, CStr(ThisWorkbook.Worksheets("Feuil1").Range("b" & i).Value)
        colQté.Add ThisWorkbook.Worksheets("Feuil1").Range("c" & i).Value, CStr(ThisWorkbook.Worksheets("Feuil1").Range("C" & i).Value)
        colPrix.Add ThisWorkbook.Worksheets("Feuil1").Range("d" & i).Value, CStr(ThisWorkbook.Worksheets("Feuil1").Range("d" & i).Value)
 
   End If
 
 
 
    i = i + 1
Loop
 
 
 
 End If
 Next y
 
K = 0
For c = 1 To colAnalYtique.Count
    UserForm1.ListBox2.AddItem
    UserForm1.ListBox2.List(K, 0) = colAnalYtique(c)
    UserForm1.ListBox2.List(K, 1) = colQté(c)
    UserForm1.ListBox2.List(K, 2) = colPrix(c)
 
    K = K + 1
 
Next c
 
UserForm1.ListBox2.ColumnWidths = "50;55;60;" 'pour adapter les largeur de colonnes
 
 
End Sub

en colonne c j'ai la Qté et en D le prix il faut aussi agrandir en largeur la listbox2 pour pouvoir

A+

**bidochon34800** · 26/04/2013, 19h52

Je l'ai tordu dans tous les sens avec mes humbles connaissances mais ça toujours quoi chose qui cloche. Je te retourne le fichier, si tu peux continuer à m'aider, ce serait sympa. Merci d'avance.

**jijie** · 26/04/2013, 20h23

Re salut,

Dans ma version précédente, tu avais tous les éléments dans la même listbox (la 2) à condition que tu l'élargisse!

Dans celle-ci tu voudrais ds 3 listbox ! L'inconvénient tu verras sur radis est que la qté (250) étant identique se note 1 fois !

voici pour ta version :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
64
65
66
67
68
69
70
71
72
Option Explicit
 
Dim strSeCtion As String
 
Sub AnalYse()
 
Dim i As Long
Dim c As Long
Dim y As Long
Dim K As Long
Dim ColSeCtion As New Collection
Dim colAnalYtique As New Collection
Dim colQté As New Collection
Dim colPrix As New Collection
 
UserForm1.ListBox2.Clear
UserForm1.ListBox3.Clear
UserForm1.ListBox4.Clear
 
     For y = 0 To UserForm1.ListBox1.ListCount - 1
 
 
 
If UserForm1.ListBox1.Selected(y) = True Then '*
 
If UserForm1.ListBox1.List(y) <> "" And UserForm1.ListBox1.List(y) <> strSeCtion Then
    strSeCtion = UserForm1.ListBox1.List(y)
End If
 
 
 
 
i = 2
 
Do While ThisWorkbook.Worksheets("Feuil1").Range("a" & i).Value <> ""
    On Error Resume Next
 
    ColSeCtion.Add ThisWorkbook.Worksheets("Feuil1").Range("a" & i).Value, CStr(ThisWorkbook.Worksheets("Feuil1").Range("a" & i).Value)
 
    If strSeCtion = "" Or ThisWorkbook.Worksheets("Feuil1").Range("a" & i).Value = strSeCtion Then
        colAnalYtique.Add ThisWorkbook.Worksheets("Feuil1").Range("b" & i).Value, CStr(ThisWorkbook.Worksheets("Feuil1").Range("b" & i).Value)
        colQté.Add ThisWorkbook.Worksheets("Feuil1").Range("c" & i).Value, CStr(ThisWorkbook.Worksheets("Feuil1").Range("C" & i).Value)
        colPrix.Add ThisWorkbook.Worksheets("Feuil1").Range("d" & i).Value, CStr(ThisWorkbook.Worksheets("Feuil1").Range("d" & i).Value)
 
   End If
 
 
 
    i = i + 1
Loop
 
 
 
 End If
 Next y
 
 
For c = 1 To colAnalYtique.Count
    UserForm1.ListBox2.AddItem colAnalYtique(c)
    UserForm1.ListBox3.AddItem colQté(c)
    UserForm1.ListBox4.AddItem colPrix(c)
 
 
 
 
 
Next c
 
 
 
 
End Sub

**bidochon34800** · 26/04/2013, 21h06

C'est pile-poil ce que je voulais. Je te promets que je ne t'embête plus, j'ai tout ce qu'il me faut et en plus j'ai compris le cheminement.
Un grand merci pour le dérangement et chapeau bas pour tes connaissances.
Merci

**jijie** · 26/04/2013, 21h15

Juste une dernière car je ne comprenais pas pourquoi tu avais mis 2 autres listbox!

si tu colle ça ds le module1 alors tu aurras ts ds 1 seule listbox

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
64
65
66
67
68
69
70
 
Option Explicit
 
Dim strSeCtion As String
 
Sub AnalYse()
 
Dim i As Long
Dim c As Long
Dim y As Long
Dim K As Long
Dim ColSeCtion As New Collection
Dim colAnalYtique As New Collection
Dim colQté As New Collection
Dim colPrix As New Collection
 
UserForm1.ListBox2.Clear
UserForm1.ListBox2.ColumnCount = 3 'pour le nbre de colonne de la listbox
     For y = 0 To UserForm1.ListBox1.ListCount - 1
 
 
 
If UserForm1.ListBox1.Selected(y) = True Then '*
 
If UserForm1.ListBox1.List(y) <> "" And UserForm1.ListBox1.List(y) <> strSeCtion Then
    strSeCtion = UserForm1.ListBox1.List(y)
End If
 
 
 
 
i = 2
 
Do While ThisWorkbook.Worksheets("Feuil1").Range("a" & i).Value <> ""
    On Error Resume Next
 
    ColSeCtion.Add ThisWorkbook.Worksheets("Feuil1").Range("a" & i).Value, CStr(ThisWorkbook.Worksheets("Feuil1").Range("a" & i).Value)
 
    If ThisWorkbook.Worksheets("Feuil1").Range("a" & i).Value = strSeCtion Then
        colAnalYtique.Add ThisWorkbook.Worksheets("Feuil1").Range("b" & i).Value
        colQté.Add ThisWorkbook.Worksheets("Feuil1").Range("c" & i).Value
        colPrix.Add ThisWorkbook.Worksheets("Feuil1").Range("d" & i).Value
 
   End If
 
 
 
    i = i + 1
Loop
 
 
 
 End If
 Next y
 
K = 0
For c = 1 To colAnalYtique.Count
    UserForm1.ListBox2.AddItem
    UserForm1.ListBox2.List(K, 0) = colAnalYtique(c)
    UserForm1.ListBox2.List(K, 1) = colQté(c)
    UserForm1.ListBox2.List(K, 2) = colPrix(c)
 
    K = K + 1
 
Next c
 
UserForm1.ListBox2.ColumnWidths = "50;55;60;" 'pour adapter les largeur de colonnes
 
 
End Sub

Pour mes connaissance (assez limités), je les puisent sur ce forum et franchement sauf quelque .... il est vraiment bien et il y a vraiment des bons !!

allez au plaisir!

Liste déroulante selon critère

Macros et VBA Excel

Discussions similaires

Partager

Partager