remplir une listbox en tenant compte de conditions

Question

Bonjour le forum 

Je m'adresse à vous car j'ai un souci de programmation sur visual basic.

En effet j'ai créer un userform avec 4 listbox à l'interieur qui vont interagir avec une base de donnée. selon les choix que l'on fait dans les listbox, on va venir copier tells ou tels cas. (Sa c'est bon j'ai réussi à le programmer).
Mais dans ma base de donnée j'aurais plusieurs fois la même version, seul la date (4° listbox) va changer. 


Donc je voudrais qu'à partir des 3 premières listbox, en choisissant dans les paramètres proposés puis en appuyant sur un bouton (exemple) on puisse trouver les différentes dates proposés mais que pour notre sélection. 

J'ai réussi en appuyant sur le bouton à ouvrir toutes les dates présentes dans la base mais pas uniquement les dates correspondant à mes critères.


Private Sub UserForm_Initialize()


'choix

Dim i As Integer
Dim Valeurs As Variant
Dim a As Object
Set a = CreateObject("Scripting.Dictionary")
    'efface le contenu de la listbox
ListBoxmodmot.Clear
    'avec la feuille base de donnée.
With Sheets("base de donnee")
        'Pour aller plus vite on charge les valeurs dans un tableau
    Valeurs = .Range("B3:B5000").Value
    For i = LBound(Valeurs) To UBound(Valeurs)
    If Not IsEmpty(Valeurs(i, 1)) Then a(Valeurs(i, 1)) = ""
Next i
End With
If IsArray(Valeurs) Then ListBoxmodmot.List = a.keys

'choix du stade

Dim j As Integer
Dim Valeurss As Variant
Dim f As Object
Set f = CreateObject("Scripting.Dictionary")
ListBoxstadmot.Clear
With Sheets("base de donnee")
    Valeurss = .Range("c3:c5000").Value
    For j = LBound(Valeurss) To UBound(Valeurss)
    If Not IsEmpty(Valeurss(j, 1)) Then f(Valeurss(j, 1)) = ""
Next j
End With
If IsArray(Valeurss) Then ListBoxstadmot.List = f.keys

'choix du type de calcul

Dim k As Integer
Dim Val As Variant
Dim g As Object

Set g = CreateObject("Scripting.Dictionary")
ListBoxcalcmot.Clear
With Sheets("base de donnee")
    Val = .Range("d3:d5000").Value
    For k = LBound(Val) To UBound(Val)
    If Not IsEmpty(Val(k, 1)) Then g(Val(k, 1)) = ""
Next k
End With
If IsArray(Val) Then ListBoxcalcmot.List = g.keys

End Sub
Private Sub ListBoxmodmot_Click()
Sheets("calcul").Range("F7").Value = ListBoxmodmot
End Sub
Private Sub ListBoxstadmot_Click()
Sheets("calcul").Range("f8").Value = ListBoxstadmot
End Sub
Private Sub ListBoxcalcmot_Click()
Sheets("calcul").Range("f9").Value = ListBoxcalcmot
End Sub

'partie rajouté
Private Sub CommandButton3_Click() 'date dispo



Dim t As Integer
Dim Vale As Variant
Dim v As Object
Set v = CreateObject("Scripting.Dictionary")
ListBoxdatemot.Clear
With Sheets("base de donnee")
    Vale = .Range("e3:e5000").Value
    For t = LBound(Vale) To UBound(Vale)
    If Not IsEmpty(Vale(t, 1)) Then v(Vale(t, 1)) = ""
Next t
End With
If IsArray(Vale) Then ListBoxdatemot.List = v.keys


End Sub

Ce programme foctionne mais il faut modifié la dernière partie (CB 3) pour qu'il prenne en compte les paramètres voulues et les dates (colonne E) qui correspondent aux choix exécuté.
Et sur cette partie je sèche complètement 


Si quelqun pourrait me donner un copu de main sa serai avec grand plaisir. 

Merci d'avance

ucfoutu · Answer

Bonjour,

Je commencerai à t'aider lorsque tu m'auras montré que tu sais ce que tu fais (ce que tu créées, pourquoi tu le crées, comment et où tu l'utilises).
C'est là une condition sine qua non à mon aide.
Sont ainsi concernés (et j'attends que tu t'expliques) :
tes objets a, f, g et v
Par ailleurs (mais accessoire pour l'instant)
Dim Val As Variant
est plutôt malheureux. Pourquoi ?
____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

Bon....
Je voudrais appeler ton attention sur un aspect :
Tu construis, à chaque foi, un tableau. Tu parcours ce tableau pour en créer un second sous forme de dictionnaire (on se demande pourquoi faire ces frais) alimenté uniquement par ce qui n'est pas vide. Puis tu alimentes ta feuille calcul par les données du dictionnaire. C'est bien tortueux.
QUESTION : comment est ta feuille "base de données" ? chaque ligne, si remplie, l'est-elle sur toutes ses colonnes B, C et D ?
Si non : as-tu, sur chacune de ces colonnes un "trou" entre la première ligne remplie et lka dernière remplie ?

Ce sont les réponses à ces questions-là qui me permettront de te guider vers une solution beaucoup moins tortueuse que ta démarche actuelle>.



____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

brux40 · Answer

Bonjour, 


Toutes les lignes ne sont pas rempli, ni même toutes les colonnes, En fait les colonnes B,C,D servent de condition, elles sont rempli par des mots pour copier le tableau qui se trouvent après (collonne F à BC), je suis d'accord sur le fait que le fait que mon programme est toruteux.

Mais j'ai réussi à trouvé uné méthode qui fonctionne et qui répond à mon problème.

Une fois de plus désolé de ne pas pouvoir trop t'aider je débute en programmation avec ce logiciel, je me suis fais aider pour créer ce programme..

Mais merci de ton aide

ucfoutu · Answer

Mais j'ai réussi à trouvé uné méthode qui fonctionne et qui répond à mon problème.

Une fois de plus désolé de ne pas pouvoir trop t'aider je débute en programmation avec ce logiciel, je me suis fais aider pour créer ce programme.. 

Bien, ma foi.
Mais prends conscience de ce que cette démarche tortueuse devra être lancée (à ta demande) chaque fois que tu modifieras les données de ta feuille "base de données". Devra d'ailleurs l'être quelle que soit la méthode retenue, mais alors : que la méthode soit la plus directe possible ! 
Mais bon ...

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

Tu devrais par exemple rappeler à celui qui t'a donné un coup de main l'existence de specialcells.
Il aurait alors peut-être quelques idées meilleures.


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

Tiens.
On va l'aider en lui "mettant la puce à l'oreille" :
Demande-lui de regarder ce que ferait ceci (exemple) :
Code Visual Basic :

 Sheets("Feuil3").Cells.ClearContents
   Worksheets("Feuil1").Range("B1:D5000").Copy Destination:=Sheets("Feuil3").Range("A1")
   Dim toto As Range
   Set toto = Sheets("Feuil3").UsedRange.SpecialCells(xlCellTypeBlanks)
   toto.Delete shift:=xlUp


Fastoche, non ?
Le reste (comment alimenter maintenant les 3 listes de ta feuille1 est alors évident, à partir de là . 


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

Ouais ... plus personne...
J'en déduis que tu tiens au principe déjà existant.
Mais alors (et pour l'amour de ton appli) ===>> un seul dico et un seul tableau des données, pour remplir tes 3 listboxes ! ===>> regarde (et très rapide) :

Option Explicit
Private Sub UserForm_Initialize()
 Dim i As Integer, j As Integer, toto, tablo, mondico As Object
  toto = Array(Nothing, ListBoxmodmot, ListBoxstadmot, ListBoxcalcmot)
  For i = 1 To 3
    toto(i).Visible = False
    toto(i).Clear
  Next
  With Sheets("base de donnée")
    tablo = .Range("B1:D5000")
    Set mondico = CreateObject("Scripting.Dictionary")
    For j = 1 To UBound(tablo, 2)
      For i = 1 To UBound(tablo, 1)
        If tablo(i, j) <> "" And Not mondico.Exists(tablo(i, j)) Then
          mondico.Add tablo(i, j), "rien à cirer"
          toto(j).AddItem tablo(i, j)
        End If
      Next
      mondico.RemoveAll
    Next
    Set mondico = Nothing
    For i = 1 To 3
      toto(i).Visible = True
    Next
  End With
End Sub


Voilà pour cet aspect 
On verra le dernier ensuite.


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

brux40 · Answer

Bonjour, désolée du retard.

Oui je vais essayer cette méthode, c'est vrai quelle est beaucoup plus rapide (et plus claire)

Merci beaucoup de ton aide.

Remplir une listbox en tenant compte de conditions

8 réponses

Votre réponse

Discussions similaires