Mise en relation de liste

Version imprimable

09/06/2016, 14h23
jeanFrançois89

Mise en relation de liste

Bonjour,

Dans le cadre d'un projet professionnel, j'ai 3 éléments à mettre en relations les un avec les autres.
Il s'agit d'une liste de quartiers (4), une liste de rues (environ 100 par quartiers) et une liste de d'incidents (3 par rue).

Mon objectif est de créer une liste déroulante dans laquelle je puisse choisir mon nom de rue et faire apparaître automatiquement le quartier où se trouve la rue ainsi que les incidents qui y sont référencés.

J'aurai besoin d'aide pour mettre en place une telle Userform s'il vous plaît.

Je vous remercie d'avance.
09/06/2016, 16h47
casefayere

1 pièce(s) jointe(s)

Bonjour,
ne connaissant pas la structure de ton fichier, un exemple à adapter, d'autres solutions sont possibles

Bonsoir,

Je vous remercie pour votre aide ! Ce tableau correspond tout à fait à mes besoins !
Cependant, j'éprouve pas mal de difficultés à comprendre comment il marche.

Pourriez-vous m'expliciter le fonctionnement des modules "définit_plage" et "plage_de_départ" ?
En effet, je n'arrive pas à rajouter une colonne d'élements et à la faire fonctionner avec les 3 que vous avez créer. Il me semble que mon point de bloqage se trouve au niveau du module "définit_plage" ou de cette partie du code :
Code:

1 2 3 4 5 For x = 1 To UBound(tB, 1) 'je boucle sur le tableau If tB(x, 1) = ListBox1 Then 'si la valeur du tableau (1ère dimension) = ListBox1 i = i + 1: ReDim Preserve Tb2(1 To i): Tb2(i) = tB(x, 2) 'j'incrémente mes autres tableaux j = j + 1: ReDim Preserve Tb3(1 To j): Tb3(j) = tB(x, 3) End If
Je vous de nouveau d'avance pour votre aide.

11/06/2016, 12h19
casefayere

Bonjour,

Citation:

En effet, je n'arrive pas à rajouter une colonne d'élements et à la faire fonctionner avec les 3 que vous avez créer.

j'ai fait un essai avec ce que tu demandais au départ et j'avais précisé

Citation:

ne connaissant pas la structure de ton fichier

peux-tu être plus clair dans ta demande
quelles colonnes sont concernées ?, quelles relations, notamment pour cette 4ème colonne,
tu as du mal à comprendre mes codes, pourtant tu as les explications avec, comment puis-je t'aider plus efficacement ?
je n'ai pas envie de te fournir comme dans mon exemple du tout cuit, alors dis-bien ce que tu ne comprends pas, les boucles ?, les tableaux ?, l'alimentation des ListBox sans doublon ?

1 pièce(s) jointe(s)

Bonjour,
J’ai fait un autre essai avec module de classe,
Tu peux faire jusque 9 colonnes dépendantes (pour +, il faudra revoir)
Tu n’as plus de procédure à élaborer pour l’évènement « Click » de chaque ListBox
La feuille contient les données en col A, B, C, etc. (elles se suivent)
Les ListBox sont nommées « ListBox1, ListBox2, etc., ça sera à toi d’adapter à ta structure

Les procédures de l’Usf nommé « Userform1 » (original) sont les suivantes :

Code:

1
2
3
Private Sub UserForm_Initialize()
Call Ini 'on va chercher la macro pour initialiser l'Usf
End Sub

Code:

1
2
3
Private Sub CommandButton1_Click()
Call Ini 'on va chercher la macro pour initialiser l'Usf
End Sub

Code:

1
2
3
Private Sub CommandButton2_Click()
Unload Me
End Sub

Deux modules standards :

Le premier :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Public tB, Dcel As Range, x As Long, c, j As Long, i As Long, Ctrl As Control
Public Dico_Listbox As Object, TbR(), Dcol As Long, Lbx As Long
Public Collect As Collection, z As Integer
 
Sub laPlage()
 
With Sheets("Feuil1")
  Dcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
  Set Dcel = .Cells(.Rows.Count, Dcol).End(xlUp)
  tB = .Range("A2", Dcel)
End With
End Sub

Le 2ème, avec 2 procédures :

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
Sub Ini()
Dim Cl As Les_ListBox
Lbx = 0
With UserForm1
'ci-dessous, on vide les Listbox (ré-initialisation)
  For Each Ctrl In UserForm1.Controls
    If TypeOf Ctrl Is MSForms.ListBox Then Ctrl.Clear: Lbx = Lbx + 1
  Next Ctrl
  Call laPlage
  ReDim TbR(1 To UBound(tB, 1))
  For z = 1 To Lbx
    For x = 1 To UBound(tB, 1)
      TbR(x) = tB(x, z)
    Next x
    Listeunique (TbR) 
    .Controls("ListBox" & z).List = Application.Transpose(Dico_Listbox.keys)  
  Next z
End With
 
Set Collect = New Collection
 For Each Ctrl In UserForm1.Controls
    'verifie s'il s'agit d'un CheckBox
    If TypeOf Ctrl Is MSForms.ListBox Then
        Set Cl = New Les_ListBox
        Set Cl.GroupeListBox = Ctrl
        Collect.Add Cl
    End If
Next Ctrl
 
End Sub

Code:

1
2
3
4
5
6
7
8
9
Sub Listeunique(Tbl) 'repris sur code exemple de boisgontier
 Set Dico_Listbox = CreateObject("Scripting.Dictionary") 
 For x = 1 To UBound(Tbl)
    Dico_Listbox(Tbl(x)) = "" 
 Next x
 For Each c In Dico_Listbox.keys
      If c = "" Then Dico_Listbox.Remove 
 Next c
End Sub

Et un module de classe nommé « Les_ListBox »

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Public WithEvents GroupeListBox As MSForms.ListBox
 
Private Sub GroupeListBox_Click()
z = Right(GroupeListBox.Name, 1)
Call laPlage
For Each Ctrl In UserForm1.Controls
  If TypeOf Ctrl Is MSForms.ListBox And Ctrl.Name <> GroupeListBox.Name Then  Ctrl.Clear
Next Ctrl
 
For j = 1 To Lbx
  If j = z And j < Lbx Then j = j + 1
  i = 0
  For x = 1 To UBound(tB, 1)
    If tB(x, z) = GroupeListBox Then
      i = i + 1: ReDim Preserve TbR(1 To i): TbR(i) = tB(x, j)
    End If
  Next x
  Listeunique (TbR)
  UserForm1.Controls("ListBox" & j).List = Application.Transpose(Dico_Listbox.keys)
Next j
End Sub

Le fichier

14/06/2016, 19h39
jeanFrançois89

Bonsoir,

Je vous remercie pour votre seconde solution. La première solution répondait à mes demandes et cette seconde est encore puissante et me permet de réaliser d'avantage que mon projet initial.

Concernant la compréhension, j'ai réussi à comprendre la première soluiton en y travaillant ce weekend. La seconde dépasse mes capacité en VBA. Je comprends le principe mais j'ai du mal à tout boucler.
Je vais continuer à me pencher dessus car c'est vraiment très utile pour mon boulot.

En tout cas, je vous remercie énormément pour le temps que vous y avez passez. Je vais continuer à étudier la seconde que vous me proposer et je reviendrai surement vers vous si je bloque.

Bonne soirée
14/06/2016, 22h22
casefayere

Bonsoir,

Citation:

En tout cas, je vous remercie énormément pour le temps que vous y avez passez. Je vais continuer à étudier la seconde que vous me proposer et je reviendrai surement vers vous si je bloque.

Pour ta 1ère phrase, lis bien ma citation
Pour la 2ème, n'hésites pas