Combobox dependantes dictionnary

[tabernake]

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 :

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 :

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

 

[patricktoulon]

re
Bonjour a tous
@ChTi160 @cp4
1° 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]

tenez voila la version match adaptée a votre event combobox1

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😉

 

[ChTi160]

Re
Nickel !
bien reçu !
Merci
jean marie

 

[tabernake]

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 :

ListBox interactive

Bonjour à tous, C'est déjà ma deuxième demande sur ce forum (ehh oui déjà),elle fait suite à la première, celle-ci est la suivante : Je souhaitais faire une ListBox interactive Je résume l'utilité du fichier Excel, on montre des priorité de sessions a remplir et le manager voit s'il lui a...

www.excel-downloads.com

Bien à vous et encore merci,
Cordialement,
tabernake