List box multicritère

Version imprimable

01/08/2013, 16h50
stéphanie123

List box multicritère

Bonjour,

J’ai crée une boite de dialogue avec des listbox pour interroger ma base de donnée avec laquelle je souhaite gérer trois colonnes.
Colonne B : Constructeur
Colonne C : Modèle
Colonne D : Motorisation

Et j’ai pour chaque colonne deux listbox. (Total 6 listbox)
Une colonne ou j’ai la liste qui se renseigne automatiquement et la seconde ou je choisi à l’aide de bouton les données que je souhaite avoir.
Le point dur c’est que les listbox sont interdépendantes je m’explique dans :
 Listbox 1 (filtre automatique sur la colonne B).
 Listbox 2 (je choisi les valeurs que je souhaite dans la listbox 1).
 Listbox 3 (filtre automatique par rapport aux données de la colonne B se trouvant dans la listbox 2 et affiche les données de la colonne C(Interaction).
 Listbox 4 (je choisi les valeurs que je souhaite dans la listbox 3).
 Listbox 5 (filtre automatique par rapport aux données de la colonne B se trouvant dans la listbox 2 et aux données de la colonne C se trouvant dans la listbox 4 et affiche les données de la colonne D (Interaction)).
 Listbox 6 (je choisi les valeurs que je souhaite dans la listbox 5).

Pour l’instant j’en suis au transfert des données de la base dans la listbox1 et le choix des données dans la listbox 2.

Si quelqu’un à déjà été exposé à ce problème ou à une idée sur comment je peux faire ?
01/08/2013, 19h15
mercatog

Tu n'auras peut être pas besoin d'autant de ListBox; 3 suffisent avec la propriété MultiSelect à True
01/08/2013, 23h53
stéphanie123

1 pièce(s) jointe(s)

list box multicritère

Oui je veux bien prendre tous les idées qui pourront me permettre de faire mon application...

Je mets ici un exemple de la boite de dialogue que j'ai faite en attendant de la compléter..

Une proposition avec 3 listbox nommées LstCon, LstMod et LstMot

A l'initialisation, on fixe le Multiselect des 3 listbox (qui pourrait être en dur dans propriétés) et on remplit sans doublons la 1ère listbox LstCon

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
Option Explicit
 
Dim Tb
Dim Constr As String
 
Private Sub UserForm_Initialize()
Dim Lastlig As Long
 
Me.LstCon.MultiSelect = fmMultiSelectMulti
Me.LstMod.MultiSelect = fmMultiSelectMulti
Me.LstMot.MultiSelect = fmMultiSelectMulti
 
With Feuil10
    Lastlig = .Cells(.Rows.Count, "B").End(xlUp).Row
    Tb = .Range("B10:H" & Lastlig).Value
End With
RemplirCons
End Sub
 
Private Sub RemplirCons()
Dim i As Long, n As Long
Dim Dico As Object
 
n = UBound(Tb, 1)
Set Dico = CreateObject("scripting.dictionary")
For i = 1 To n
    If Not Dico.exists(Tb(i, 1)) Then Dico.Add Tb(i, 1), Tb(i, 1)
Next i
If Dico.Count > 0 Then Me.LstCon.List = Dico.items
Set Dico = Nothing
End Sub

Ensuite à chaque choix (simple ou multiple) dans LstCon, on remplit LstMod sans doublons

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
Private Sub LstCon_Change()
Dim i As Long
 
Me.LstMod.Clear
Me.LstMot.Clear
Constr = ""
With Me.LstCon
    For i = 0 To .ListCount - 1
        If .Selected(i) Then Constr = Constr & ";" & .List(i)
    Next i
End With
RemplirMod Constr
End Sub
 
Private Sub RemplirMod(ByVal Str As String)
Dim i As Long, n As Long
Dim Dico As Object
 
If Me.LstCon.ListIndex > -1 Then
    n = UBound(Tb, 1)
    Set Dico = CreateObject("scripting.dictionary")
    For i = 1 To n
        If InStr(Str, ";" & Tb(i, 1)) Then
            If Not Dico.exists(CStr(Tb(i, 2))) Then Dico.Add CStr(Tb(i, 2)), CStr(Tb(i, 2))
        End If
    Next i
    If Dico.Count > 0 Then Me.LstMod.List = Dico.items
    Set Dico = Nothing
End If
End Sub

Et au choix de LstMod on remplit LstMot sans doublons

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
Private Sub LstMod_Change()
Dim Model As String
Dim i As Long
 
Me.LstMot.Clear
With Me.LstMod
    For i = 0 To .ListCount - 1
        If .Selected(i) Then Model = Model & ";" & .List(i)
    Next i
End With
RemplirMot Constr, Model
 
End Sub
 
Private Sub RemplirMot(ByVal Co As String, ByVal Mo As String)
Dim i As Long, n As Long
Dim Dico As Object
 
Me.LstMot.Clear
If Me.LstMod.ListIndex > -1 Then
    n = UBound(Tb, 1)
    Set Dico = CreateObject("scripting.dictionary")
    For i = 1 To n
        If InStr(Co, ";" & Tb(i, 1)) > 0 And InStr(Mo, ";" & Tb(i, 2)) > 0 Then
            If Not Dico.exists(Tb(i, 3)) Then Dico.Add Tb(i, 3), Tb(i, 3)
        End If
    Next i
    If Dico.Count > 0 Then Me.LstMot.List = Dico.items
    Set Dico = Nothing
End If
End Sub

Fichier d'illustration

02/08/2013, 14h01
stéphanie123

- Merci sa marche très bien et en plus du premier coup génial...:ccool:;)
********Vu que les difficultés que je rencontre concernent les listes box je continue sur ce post sa me permet en même temps d'avoir aussi toute mon application sur le même fil et peut être servir à une autre personne...:ccool:;)

Ci joint la suite de mon application reformulé ///

Ce quelle doit faire :
Chercher les données affiché dans listbox copié/collé sans doublons et additionnée les valeurs pour chaque données présentent dans la liste box dans feuille « «x »

Je vais essayée d’être la plus claire possible !!!

Je souhaite chercher à partir de la listbox3 « LstMot » sélectionnées, les données dans la feuille (« Liste pièce de rechange »).colonne (« D10 :D)

• Chaque fois que la valeur est trouvé alors copié sans doublons les données de la ligne (« E10 :G ») dans la feuille (« 7- Fiche pièces de rechange »).colonne (« A7 :C ») mais aussi….
• Chaque fois que la valeur trouvé dans la feuille (« Liste pièce de rechange »).colonne (« D10 :D) additionné les valeurs de la colonne.(G10 :G) trouvées et collées les valeurs dans la feuille (« 7-Fiche pièces de rechange ») .colonnes (« D7 :D) équivalent à la ligne collée précédemment.

Je pense que si j’arrive à traduire sa en code alors mon application sera faite mais je ne suis pas encore sortie de l’auberge…:aie:

Comme indiqué dans les données j’aurais besoins de deux boucles « for each » imbriqué mais je ne sais vraiment pas comment faire ça !!!:calim2:

Ajoute ce code (pour la bouton Valider)

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
Private Sub CommandButton10_Click()
Dim LastLig As Long, i As Long, j As Long, n As Long
Dim Dico As Object
Dim Tmp As String
Dim Res(), Tbl, T
 
With Me.LstMot
    If .ListIndex > -1 Then
        n = UBound(Tb, 1)
        Set Dico = CreateObject("Scripting.Dictionary")
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                Tmp = .List(i)
                For j = 1 To n
                    If Tb(j, 3) = Tmp Then
                        If Not Dico.exists(Tb(j, 4)) Then
                            Dico.Add Tb(j, 4), Tb(j, 4) & "|" & Tb(j, 5) & "|" & Tb(j, 6) & "|" & Tb(j, 7)
                        Else
                            Dico(Tb(j, 4)) = Som(Dico(Tb(j, 4)), Tb(j, 7))
                        End If
                    End If
                Next j
            End If
        Next i
 
        n = Dico.Count
        If n > 0 Then
            Tbl = Dico.items
            ReDim Res(1 To n, 1 To 4)
            For i = 1 To n
                T = Split(Tbl(i - 1), "|")
                Res(i, 1) = T(0)
                Res(i, 2) = T(1)
                Res(i, 3) = T(2)
                Res(i, 4) = Val(T(3))
            Next i
            With Feuil1
                LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
                If LastLig > 6 Then .Range("A7:D" & LastLig).ClearContents
                .Range("A7").Resize(n, 4) = Res
            End With
        End If
        Set Dico = Nothing
        Unload Me
    End If
End With
End Sub
 
Private Function Som(ByVal Str As String, ByVal Q As Double) As String
Dim Tbl
 
Tbl = Split(Str, "|")
 
Som = Tbl(0) & "|" & Tbl(1) & "|" & Tbl(2) & "|" & CStr(Val(Tbl(3)) + Q)
End Function

04/08/2013, 02h24
stéphanie123

Comment je suis contente que sa marche, je suis dessus depuis ce matin et là c'est la délivrance...
J'ai fais le test ça marche très bien...je vais pouvoir aller me choucher...
Encore une fois merci Mercatog:ccool::ccool::ccool:

List box multicritère

Bonsoir,

Je re ouvre ce post, car le code marche très bien pour l’exemple que j’ai créée.
Mais comme dans mon application finale les colonnes comparées ne sont pas côte à côte…Cela ne marche plus du tout…

Voici les colonnes qui bougent dans mon application finale :

Q à la place E …….je remplace colonne 5 par 17
E à la place F …….je remplace colonne 6 par 5
T à la place g……..je remplace colonne 7 par 20
Et H reste à sa place pas de changement

Dois-je modifier que cette partie du code ?
Code:

1 2 3 4 5 If Not Dico.exists(Tb(j, 4)) Then Dico.Add Tb(j, 4), Tb(j, 4) & "|" & Tb(j, 5) & "|" & Tb(j, 6) & "|" & Tb(j, 7) Else Dico(Tb(j, 4)) = Som(Dico(Tb(j, 4)), Tb(j, 7)) End If
Quand je remplace les données dans cet ordre là ça ne marche plus…
Y a-t-il d’autre partie du code que je dois touchée où le code ne marche pas quand les colonnes ne sont pas côte à côte ?

06/08/2013, 01h21
mercatog

Oui, la définition de Tb dans le Code Initialize.

ça ne sera plus

Code:

Tb=.Range("B10:H" & LastLig).Value
06/08/2013, 01h46
stéphanie123

List box critère

Parfait ! Je n'y avait pas pensée encore une fois merci...:ccool: