Résolu Combobox dependantes dictionnary

tabernake

XLDnaute Nouveau
Bonjour à tous,

Étant débutant dans le VBA, mais grâce à l'aide de votre forum j'ai pu avancer sur ma macro, mais la je bloque depuis quelques jours.

Je vous explique :

Pour mon entreprise, je dois effectuer une macro qui permet à des managers de voir des informations.

J'ai donc créer un formulaire de recherche :
form.PNG

Hors lorsque je sélectionne un manager, je voudrais que le choix des agents se réduit, afin que le manager ne voit que ses agents, et pareil pour le stage, je voudrais que le manager voit que les stages de l'agent qu'il a sélectionné.

Ainsi une fois ces 3 combobox remplie que ça m'affiche dans la textbox seulement les dates disponibles pour le stage demandé.

Les informations concernant le manager, l'agent et le stage sont dans un classeur nommé "Besoin"

Les informations concernant la date et le stage est répété aussi dans un classeur nommé "Session"

Mon code à l'heure d'aujourd'hui me permet pas de réduire les choix possibles dans les combobox

Voici le code :

VB:
Private Sub Quitter_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
Me.ComboBox1.Clear
Dim F As Worksheet

  Set F = Sheets("Besoin")
  Set mondico = CreateObject("Scripting.Dictionary")

  a = F.Range("D2:D" & F.[D65000].End(xlUp).Row)   ' tableau a(n,1) pour rapidité

  For i = LBound(a) To UBound(a)
    If a(i, 1) <> "" Then mondico(a(i, 1)) = ""
  Next i
  '--avec tri
  temp = mondico.keys
  Call Tri(temp, LBound(temp), UBound(temp))
  Me.ComboBox1.List = temp

End Sub

Sub Tri(a, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2)
  G = gauc: d = droi
  Do
     Do While a(G) < ref: G = G + 1: Loop
     Do While ref < a(d): d = d - 1: Loop
     If G <= d Then
        temp = a(G): a(G) = a(d): a(d) = temp
        G = G + 1: d = d - 1
     End If
   Loop While G <= d
   If G < droi Then Call Tri(a, G, droi)
   If gauc < d Then Call Tri(a, gauc, d)
End Sub

Private Sub ComboBox1_Change()

Dim F As Worksheet
Dim n As Variant

Dico_2:
  Set F = Sheets("Besoin")
  Set mondico = CreateObject("Scripting.Dictionary")

  a = F.Range("B2:B" & F.[B65000].End(xlUp).Row)   ' tableau a(n,1) pour rapidité

  For i = LBound(a) To UBound(a)
    If a(i, 1) <> "" Then mondico(a(i, 1)) = ""
  Next i
  '--avec tri
  temp = mondico.keys
  Call Tri(temp, LBound(temp), UBound(temp))
  Me.ComboBox2.List = temp

End Sub
En espérant que vous pussiez m'aide;

Bien cordialement form.PNG
 

cp4

XLDnaute Impliqué
Bonjour à tous,

Étant débutant dans le VBA, mais grâce à l'aide de votre forum j'ai pu avancer sur ma macro, mais la je bloque depuis quelques jours.

Je vous explique :

Pour mon entreprise, je dois effectuer une macro qui permet à des managers de voir des informations.

J'ai donc créer un formulaire de recherche :
Voir la pièce jointe 1081404

Hors lorsque je sélectionne un manager, je voudrais que le choix des agents se réduit, afin que le manager ne voit que ses agents, et pareil pour le stage, je voudrais que le manager voit que les stages de l'agent qu'il a sélectionné.

Ainsi une fois ces 3 combobox remplie que ça m'affiche dans la textbox seulement les dates disponibles pour le stage demandé.

Les informations concernant le manager, l'agent et le stage sont dans un classeur nommé "Besoin"

Les informations concernant la date et le stage est répété aussi dans un classeur nommé "Session"

Mon code à l'heure d'aujourd'hui me permet pas de réduire les choix possibles dans les combobox

Voici le code :

VB:
Private Sub Quitter_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
Me.ComboBox1.Clear
Dim F As Worksheet

  Set F = Sheets("Besoin")
  Set mondico = CreateObject("Scripting.Dictionary")

  a = F.Range("D2:D" & F.[D65000].End(xlUp).Row)   ' tableau a(n,1) pour rapidité

  For i = LBound(a) To UBound(a)
    If a(i, 1) <> "" Then mondico(a(i, 1)) = ""
  Next i
  '--avec tri
  temp = mondico.keys
  Call Tri(temp, LBound(temp), UBound(temp))
  Me.ComboBox1.List = temp

End Sub

Sub Tri(a, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2)
  G = gauc: d = droi
  Do
     Do While a(G) < ref: G = G + 1: Loop
     Do While ref < a(d): d = d - 1: Loop
     If G <= d Then
        temp = a(G): a(G) = a(d): a(d) = temp
        G = G + 1: d = d - 1
     End If
   Loop While G <= d
   If G < droi Then Call Tri(a, G, droi)
   If gauc < d Then Call Tri(a, gauc, d)
End Sub

Private Sub ComboBox1_Change()

Dim F As Worksheet
Dim n As Variant

Dico_2:
  Set F = Sheets("Besoin")
  Set mondico = CreateObject("Scripting.Dictionary")

  a = F.Range("B2:B" & F.[B65000].End(xlUp).Row)   ' tableau a(n,1) pour rapidité

  For i = LBound(a) To UBound(a)
    If a(i, 1) <> "" Then mondico(a(i, 1)) = ""
  Next i
  '--avec tri
  temp = mondico.keys
  Call Tri(temp, LBound(temp), UBound(temp))
  Me.ComboBox2.List = temp

End Sub
En espérant que vous pussiez m'aide;

Bien cordialement Voir la pièce jointe 1081404
Bonjour,

Tu pourrais t'inspirer de cet exemple de ce fil
 

tabernake

XLDnaute Nouveau
Bonjour,
Tout d'abord un grand merci, grâce a vous j'ai pu me dépatouiller et avancer, mais j'ai une derniere question, je n'arrive pas recupérer les informations pour ma listbox

Ces informations sont dans un classeur nommé "Session", dans lequel il y a 3 colonnes
1 Stage
1 Date
1 Places disponibles

Je n'arrive pas à trouver une solution malgré votre fichier sur le vin

Voici mon code :
VB:
Private Sub Quitter_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()

Dim f As Worksheet

  Set f = Sheets("Besoin")
  Set mondico = CreateObject("Scripting.Dictionary")
 
  a = f.Range("A2:D" & f.[D65000].End(xlUp).Row)   ' tableau a(n,1) pour rapidité
 
  For i = LBound(a) To UBound(a)
    If a(i, 4) <> "" Then mondico(a(i, 4)) = ""
  Next i
  '--avec tri
  temp = mondico.keys
  Call Tri(temp, LBound(temp), UBound(temp))
  Me.ComboBox1.List = temp
 
'Paramètrage de la ListBox
Me.ListBox1.ColumnCount = 3 'Nombre de colonne
Me.ListBox1.ColumnWidths = "150; 50; 30" 'La taille de la colonne 1,2 et 3
 
End Sub

Sub Tri(a, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2)
  G = gauc: d = droi
  Do
     Do While a(G) < ref: G = G + 1: Loop
     Do While ref < a(d): d = d - 1: Loop
     If G <= d Then
        Tbl = a(G): a(G) = a(d): a(d) = Tbl
        G = G + 1: d = d - 1
     End If
   Loop While G <= d
   If G < droi Then Call Tri(a, G, droi)
   If gauc < d Then Call Tri(a, gauc, d)
End Sub

Private Sub ComboBox1_Change() 'Un manager est sélectionné

Me.ComboBox2.Clear
Me.ComboBox3.Clear
Me.ListBox1.Clear
Dim f As Worksheet

Set f = Sheets("Besoin")
Set mondico = CreateObject("Scripting.Dictionary")

a = f.Range("A2:D" & f.[D65000].End(xlUp).Row)

    For i = LBound(a) To UBound(a)
        If a(i, 4) = Me.ComboBox1 Then mondico(a(i, 2)) = ""
    Next i
temp = mondico.keys
Call Tri(temp, LBound(temp), UBound(temp))
Me.ComboBox2.List = temp
    

End Sub

Private Sub ComboBox2_Change() 'Un agent est sélectionné

Me.ComboBox3.Clear
Me.ListBox1.Clear
Dim f As Worksheet

Set f = Sheets("Besoin")
Set mondico = CreateObject("Scripting.Dictionary")

a = f.Range("A2:D" & f.[D65000].End(xlUp).Row)

    For i = LBound(a) To UBound(a)
        If a(i, 4) = Me.ComboBox1 And a(i, 2) = Me.ComboBox2 Then mondico(a(i, 3)) = ""
    Next i
temp = mondico.keys
Call Tri(temp, LBound(temp), UBound(temp))
Me.ComboBox3.List = temp

End Sub

Private Sub Valider_Click()

'--C'est ici que ça ne marche pas--

'Stage en colonne A (1) de la feuille session
'Date en colonne B (2)
' Place disponible en colonne C (3)

Dim lg, i, j
Set SS = Sheets("Session")

Me.ListBox1.Clear
For j = 2 To 10000
    If SS.Range("A" & j) = Me.ComboBox3 Then
    Set c = j
    If Not c Is Nothing Then
        premier = c.Address
        i = 0
        Do
        Me.ListBox1.AddItem
        Me.ListBox1.List(i, 0) = c.Value(0, 2)
        Set c = Rng.FindNext(c)
        i = i + 1
        Loop While Not c Is Nothing And c.Address <> premier
        End If
    End If
Next j
End Sub
Ça me dit que "Set c=j" c'est une incompatibilité de type

En espérant que vous puissiez m'aider.

Bien à vous
 

cp4

XLDnaute Impliqué
Bonjour,
Tout d'abord un grand merci, grâce a vous j'ai pu me dépatouiller et avancer, mais j'ai une derniere question, je n'arrive pas recupérer les informations pour ma listbox

Ces informations sont dans un classeur nommé "Session", dans lequel il y a 3 colonnes
1 Stage
1 Date
1 Places disponibles

Je n'arrive pas à trouver une solution malgré votre fichier sur le vin

Voici mon code :
VB:
Private Sub Quitter_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()

Dim f As Worksheet

  Set f = Sheets("Besoin")
  Set mondico = CreateObject("Scripting.Dictionary")

  a = f.Range("A2:D" & f.[D65000].End(xlUp).Row)   ' tableau a(n,1) pour rapidité

  For i = LBound(a) To UBound(a)
    If a(i, 4) <> "" Then mondico(a(i, 4)) = ""
  Next i
  '--avec tri
  temp = mondico.keys
  Call Tri(temp, LBound(temp), UBound(temp))
  Me.ComboBox1.List = temp

'Paramètrage de la ListBox
Me.ListBox1.ColumnCount = 3 'Nombre de colonne
Me.ListBox1.ColumnWidths = "150; 50; 30" 'La taille de la colonne 1,2 et 3

End Sub

Sub Tri(a, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2)
  G = gauc: d = droi
  Do
     Do While a(G) < ref: G = G + 1: Loop
     Do While ref < a(d): d = d - 1: Loop
     If G <= d Then
        Tbl = a(G): a(G) = a(d): a(d) = Tbl
        G = G + 1: d = d - 1
     End If
   Loop While G <= d
   If G < droi Then Call Tri(a, G, droi)
   If gauc < d Then Call Tri(a, gauc, d)
End Sub

Private Sub ComboBox1_Change() 'Un manager est sélectionné

Me.ComboBox2.Clear
Me.ComboBox3.Clear
Me.ListBox1.Clear
Dim f As Worksheet

Set f = Sheets("Besoin")
Set mondico = CreateObject("Scripting.Dictionary")

a = f.Range("A2:D" & f.[D65000].End(xlUp).Row)

    For i = LBound(a) To UBound(a)
        If a(i, 4) = Me.ComboBox1 Then mondico(a(i, 2)) = ""
    Next i
temp = mondico.keys
Call Tri(temp, LBound(temp), UBound(temp))
Me.ComboBox2.List = temp
   

End Sub

Private Sub ComboBox2_Change() 'Un agent est sélectionné

Me.ComboBox3.Clear
Me.ListBox1.Clear
Dim f As Worksheet

Set f = Sheets("Besoin")
Set mondico = CreateObject("Scripting.Dictionary")

a = f.Range("A2:D" & f.[D65000].End(xlUp).Row)

    For i = LBound(a) To UBound(a)
        If a(i, 4) = Me.ComboBox1 And a(i, 2) = Me.ComboBox2 Then mondico(a(i, 3)) = ""
    Next i
temp = mondico.keys
Call Tri(temp, LBound(temp), UBound(temp))
Me.ComboBox3.List = temp

End Sub

Private Sub Valider_Click()

'--C'est ici que ça ne marche pas--

'Stage en colonne A (1) de la feuille session
'Date en colonne B (2)
' Place disponible en colonne C (3)

Dim lg, i, j
Set SS = Sheets("Session")

Me.ListBox1.Clear
For j = 2 To 10000
    If SS.Range("A" & j) = Me.ComboBox3 Then
    Set c = j
    If Not c Is Nothing Then
        premier = c.Address
        i = 0
        Do
        Me.ListBox1.AddItem
        Me.ListBox1.List(i, 0) = c.Value(0, 2)
        Set c = Rng.FindNext(c)
        i = i + 1
        Loop While Not c Is Nothing And c.Address <> premier
        End If
    End If
Next j
End Sub
Ça me dit que "Set c=j" c'est une incompatibilité de type

En espérant que vous puissiez m'aider.

Bien à vous
Bonjour,
Le fichier n'est pas le mien c'est celui du demandeur. Je te conseille de joindre ton fichier avec des données anonymes, ça sera plus simple.
A première vue, il te manque la procédure Private Sub ComboBox3_Change() pour alimenter la Listbox.
Si ça peut t'aider dans le fichier vin, la Listbox s'alimente à partir de la textbox (code ci-dessous à adapter à ta denière combobox).
VB:
Private Sub TxtLieu_Change()
   For i = 1 To UBound(BD)          ' on explore la colonne de niveau 4
      If BD(i, 2) = Me.ComboAppellation And BD(i, 3) = Me.ComboBox1 _
         And BD(i, 4) = Me.ComboCouleur And UCase(BD(i, 1)) = Me.TxtLieu Then
         Me.ListBoxVin.AddItem BD(i, 5)
         Me.ListBoxVin.List(Me.ListBoxVin.ListCount - 1, 1) = BD(i, 7)
         Me.ListBoxVin.List(Me.ListBoxVin.ListCount - 1, 2) = BD(i, 26)
         Me.ListBoxVin.List(Me.ListBoxVin.ListCount - 1, 3) = BD(i, 10)
         Me.ListBoxVin.List(Me.ListBoxVin.ListCount - 1, 4) = BD(i, 12)
         Me.ListBoxVin.List(Me.ListBoxVin.ListCount - 1, 5) = BD(i, 11)
         Me.ListBoxVin.List(Me.ListBoxVin.ListCount - 1, 6) = BD(i, 15)

      End If
   Next i
End Sub
A+
 

ChTi160

XLDnaute Barbatruc
Bonsoir tabernake
Bonsoir cp4 que je salue , le Forum
Pour bien comprendre : tu as deux Classeurs différents pour travailler !
l'un pour le manager, l'agent et le stage nommé "Besoin"
l'autre pour Les informations concernant la date et le stage nommé "Session"
les deux sont ouverts ?
merci
jean marie
 

tabernake

XLDnaute Nouveau
Bonjour à vous deux,

J'ai donc créée un fichier sans informations confidentielles, afin que vous puissiez travailler à partir de celui-ci

La demande est la suivante :
Que le stage ainsi que chaque date de disponibles (chaque date de session de ce stage) soit affiché dans la listbox, si seulement il y au moins 1 place de disponible dans la session.

J'ai donc bien 2 classeurs afin de séparer les infos, car besoin peut comporter 10000 lignes et Session lui 80.
Je ne maitrise pas assez les listbox afin de renseigner les informations que je désire.

Je vous en remercie d'avance.
Bien à vous
 

Fichiers joints

ChTi160

XLDnaute Barbatruc
Bonsoir cp4
Histoire de te saluer à nouveau , je me suis permis de rajouter ceux-ci
VB:
Me.ComboBox3.List = temp
If Me.ComboBox3.ListCount = 1 Then Me.ComboBox3.ListIndex = 0 ' ça
si un seul Choix possible dans le Combobox3 on l'affiche !
Bonne fin de Soirée
jean marie
 
  • J'aime
Reactions: cp4

patricktoulon

XLDnaute Barbatruc
bonsoir
juste en passant pour vous montrer que l'on peut se passer de dictionnaire pour un controls de liste (SANS DOUBLONS)
juste comme ça vite fait
VB:
Private Sub ComboBox1_Change()    'Un manager est sélectionné
    Dim temp(), x&
    Me.ComboBox2.Clear
    Me.ComboBox3.Clear
    Me.ListBox1.Clear
    Dim f As Worksheet
    Set f = Sheets("Besoin")
    ReDim Preserve temp(0 To 1)
    a = f.Range("A2:D" & f.[D65000].End(xlUp).Row)
    For i = LBound(a) To UBound(a)
        If a(i, 4) = Me.ComboBox1 Then
            ComboBox2.Value = (a(i, 2))
            If ComboBox2.ListIndex = -1 Then ComboBox2.AddItem (a(i, 2)): ReDim Preserve temp(0 To x): temp(x) = a(i, 2): x = x + 1
        End If
    Next i
    Call Tri(temp, LBound(temp), UBound(temp))
    Me.ComboBox2.List = temp
End Sub
 
  • J'aime
Reactions: cp4

ChTi160

XLDnaute Barbatruc
Bonjour Patrick
Bonjour le Fil ,le Forum
Effectivement ,j'avais déjà vu cette méthode mais j'arrive pas a mis mettre lol.
questions :
Pourquoi tu mets :
ReDim Preserve temp(0 To 1)
Pour ensuite mettre ReDim Preserve Temp(0 To x) ?
Après le tri , pas besoin de vider le control ComboBox2( Clear ) ?
Merci de ce partage .
Bonne journée
Jean marie
 
Dernière édition:

cp4

XLDnaute Impliqué
Bonsoir cp4
Histoire de te saluer à nouveau , je me suis permis de rajouter ceux-ci
VB:
Me.ComboBox3.List = temp
If Me.ComboBox3.ListCount = 1 Then Me.ComboBox3.ListIndex = 0 ' ça
si un seul Choix possible dans le Combobox3 on l'affiche !
Bonne fin de Soirée
jean marie
Bonjour Jean Marie ;),
Merci beaucoup pour ton rajout, ça me permet de m'améliorer.
Bonne journée.
 

cp4

XLDnaute Impliqué
bonsoir
juste en passant pour vous montrer que l'on peut se passer de dictionnaire pour un controls de liste (SANS DOUBLONS)
juste comme ça vite fait
VB:
Private Sub ComboBox1_Change()    'Un manager est sélectionné
    Dim temp(), x&
    Me.ComboBox2.Clear
    Me.ComboBox3.Clear
    Me.ListBox1.Clear
    Dim f As Worksheet
    Set f = Sheets("Besoin")
    ReDim Preserve temp(0 To 1)
    a = f.Range("A2:D" & f.[D65000].End(xlUp).Row)
    For i = LBound(a) To UBound(a)
        If a(i, 4) = Me.ComboBox1 Then
            ComboBox2.Value = (a(i, 2))
            If ComboBox2.ListIndex = -1 Then ComboBox2.AddItem (a(i, 2)): ReDim Preserve temp(0 To x): temp(x) = a(i, 2): x = x + 1
        End If
    Next i
    Call Tri(temp, LBound(temp), UBound(temp))
    Me.ComboBox2.List = temp
End Sub
Bonjour PatrickToulon;),
Merci beaucoup pour ton partage. Je ne connaissais pas du tout cette façon de procéder.
Encore merci et bonne journée.
 

patricktoulon

XLDnaute Barbatruc
re
Bonjour a tous
@ChTi160 @cp4
ou j'aurais du mettre redim( temp(1) voir par de redim du tout puisque je le fait en aval lors du test listindex
l’habitude de jouer avec le base(0/1)

2° après tri non pas besoins puisque j'utilise . list =temp donc temp remplace la totalité de ce qui y a dedans la liste
disons que cette méthode est compatible all versions y compris MAC

j'ai ai une autre aussi simple avec match si vous voulez
 

patricktoulon

XLDnaute Barbatruc
tenez voila la version match adaptée a votre event combobox1
VB:
Private Sub ComboBox1_Change()    'Un manager est sélectionné
    Dim temp(), f As Worksheet, x&

    ReDim Preserve temp(1)
     Me.ComboBox3.Clear
    Me.ListBox1.Clear
 
    Set f = Sheets("Besoin")
    a = f.Range("A2:D" & f.[D65000].End(xlUp).Row)
   
    For i = LBound(a) To UBound(a)
        If a(i, 4) = Me.ComboBox1 Then
            If Application.IfError(Application.Match(a(i, 2), temp, 0), 0) = 0 Then
              ReDim Preserve temp(0 To x):  temp(x) = a(i, 2): x = x + 1
            End If
        End If
    Next i
   
     Call Tri(temp, LBound(temp), UBound(temp))
    Me.ComboBox2.List = temp
End Sub
explication:

1° je dim temp vide;dim temp() c'est la déclaration de la variable

2° je redim preserve une fois a 1 pour qu'il y est au moins un item sinon le match va déclencher une erreur puisque pas d'item

3°vous constaterez que j'utilise la gestion d'erreur de match en amont avec application.iferror
et oui match n'a pas de gestion interne quand il trouve pas ( je vais pas vous l'apprendre )
ce qui me permet de transformer error!! en 0

4° donc lors du non match( donc 0) je redim preserve normalement avec itération de "x" (ca vous connaissez )

et voila votre liste n'a pas de doublons

oserais je dire aussi que vous pouvez faire la meme chose que le dico avec une collection qui est interne a vba

voila au final vous avez largement de quoi vous defaire du Sripting dico

voila j’espère avoir répondu a vos interrogations;)
 
Dernière édition:
  • J'aime
Reactions: cp4

tabernake

XLDnaute Nouveau
Bonjour, à tous,

Après de nombreux imprévues, je replonge sur ce problème, je vous remercie tous pour votre participations actives à mon problème.
Votre participation m'a permis de régler la première partie de mon problème

Je sollicite votre aide à nouveau (et je m'en excuse), je vous met ci-dessous le lien forum du second problème :

Bien à vous et encore merci,
Cordialement,
tabernake
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas