Résolu dictionary et listbox

Mickoik

Habitué
Bonjour,
j'ai une macro un peu longue et une procédure un peu tirée par les cheveux mais qui fonctionne plutôt bien. Le truc, c'est que j'ai besoin de changer la procédure et je voudrais que les résultats s'affichent dans une listbox. Mais là j'ai besoin de votre aide parce que c'est un peu trop compliqué pour moi.

J'explique ma procédure actuelle :

je vais chercher les éléments que je veux comme ça :

CSS:
For Each macellule In client_materiel
If macellule = client.Value Then


Sheets("Gestion des installations").Cells(macellule.Row, 15).Copy Destination:=Sheets("Rechercher Client").Range("BA" & Rows.Count).End(xlUp).Offset(1, 0)

derligcam = Sheets("Rechercher Client").Range("BA" & Rows.Count).End(xlUp).Row

Sheets("Gestion des installations").Cells(macellule.Row, 13).Copy Destination:=Sheets("Rechercher Client").Range("BB" & derligcam)
Sheets("Gestion des installations").Cells(macellule.Row, 14).Copy Destination:=Sheets("Rechercher Client").Range("AZ" & derligcam)

Sheets("Gestion des installations").Cells(macellule.Row, 16).Copy Destination:=Sheets("Rechercher Client").Range("BA" & Rows.Count).End(xlUp).Offset(1, 0)
Sheets("Gestion des installations").Cells(macellule.Row, 17).Copy Destination:=Sheets("Rechercher Client").Range("BA" & Rows.Count).End(xlUp).Offset(1, 0)
Sheets("Gestion des installations").Cells(macellule.Row, 18).Copy Destination:=Sheets("Rechercher Client").Range("BA" & Rows.Count).End(xlUp).Offset(1, 0)
Sheets("Gestion des installations").Cells(macellule.Row, 19).Copy Destination:=Sheets("Rechercher Client").Range("BA" & Rows.Count).End(xlUp).Offset(1, 0)
Sheets("Gestion des installations").Cells(macellule.Row, 20).Copy Destination:=Sheets("Rechercher Client").Range("BA" & Rows.Count).End(xlUp).Offset(1, 0)

End If
Next

ensuite, directement sur la tableau excel je complète les trous avec des formules du type :
=SI(OU(BA3="";BA3="x");"";SI(BB3="";AX2;BB3))
ou bien
=SI(AZ11="";SI(OU(BA11="";BA11="x");"";1);AZ11)

parce que je tableau que je traite a des trous mais ces trous sont facile à compléter avec les 2 formules ci-dessous.

J'obtient donc un deuxième tableau que je traite comme ça :

CSS:
Set d1 = CreateObject("Scripting.Dictionary")
  a = Range("AV2:AY" & [ba65000].End(xlUp).Row)
  j = 0
  For i = LBound(a) To UBound(a)
    If Not d1.exists(a(i, 2)) Then j = j + 1: d1(a(i, 2)) = j
  Next i
  Dim b():  ReDim b(1 To d1.Count, 1 To UBound(a, 2))
  For ligne = LBound(a) To UBound(a)
     p = d1(a(ligne, 2))
     b(p, 1) = b(p, 1) + a(ligne, 1)
     For K = 2 To 4: b(p, K) = a(ligne, K): Next K
  Next ligne
  [AR1].Resize(UBound(b), UBound(b, 2)) = b

   [AT1].Sort Key1:=[AT1], Order1:=xlAscending, Header:=xlYes

Ce troisième tableau correspond à mon résultat.

J'aimerai arriver à faire tout ça sans avoir besoin d'utiliser le tableau excel et faire apparaître le résultat final directement dans une listbox.

Vous pensez que c'est possible ?
 

drul

Obscur pro du hardware
Staff
Salut, c'est pas très clair là ... tu veux ne pas du tout passer par un tableau "intermédiaire" ? Tu aimerais "remplir" les trous automatiquement ?
Ta 2eme macro est horrible à lire, deux instructions par ligne, variable avec des noms à une seule lettre, aucun commentaire ...
 

Mickoik

Habitué


Question 1 : oui c'est exactement ça

Question 2 : c'est une macro que j'ai prise sur internet sur ce site :
elle me permet de réorganiser le tableau numéro 2 à savoir :
si par exemple, j'ai 3 lignes avec produit A en 2ème colonne, quantité 1 en première colonne et la même date en 3ème colonne, il me rassemble une seule ligne avec 3; produits A; telle date
 

drul

Obscur pro du hardware
Staff
Et comment faire pour remplir les trous automatiquement, tu donnes 2 formules, y en a-t-il d'autre ? comment décides tu laquelle appliquée ?
Techniquement je pense que tu pourras assez facilement t'en sortir en utilisant uniquement le dictionnary (peut-être un 2eme sera t'il nécessaire ...) , mais le point bloquant semble être ce remplissage "manuelle" que tu fais
 

Mickoik

Habitué


mon deuxième tableau a 3 colonnes et dans toute la colonne, c'est la même formule (le numéro de la cellule descend au fur et à mesure des lignes)
1) =SI(AZ2="";SI(OU(BA2="";BA2="x");"";1);AZ2) (c'est la quantité récupérée dans ma base)
2) =SI(OU(BA2="";BA2="x");"";BA2) (c'est le matériel)
3) =SI(OU(BA2="";BA2="x");"";SI(BB2="";AX1;BB2)) (c'est la date d'installation)

 

drul

Obscur pro du hardware
Staff
Encore un truc qui m'échappe:
tu première macro rempli un tableau en AZ/BA/ BB tu deuxième macro semble travailler avec une sourceen AV:AY
Ou est le lien entre ces 2 plages ???
 

Mickoik

Habitué


AV : AY c'est la plage où sont écrites les formules qui traitent les infos récoltées dans AZ:BB (pour boucher les trous). Pour utiliser dictionary correctement, je récolte les données dans AZ:BB, je bouche les trous dans AV:AY et j'affiche le résultat de la macro dictionary dans AR:AT
 

drul

Obscur pro du hardware
Staff
Ok, je crois que j'ai compris ... :pt1cable:

Ok, ton premier "exercice":
- dans ta boucle for each tu vas remplir un tableau à 2 dimension (myArray(n,3)) au lieu d'un tableau excel

ensuite, il faudra traiter ce premier tableau afin de compléter les trous, puis le passer à la méthode "dictonnary"
 

Mickoik

Habitué


ok je reviens une fois que j'ai appris à le faire
 

Mickoik

Habitué
Bonjour drul

j'en suis la dans le code mais je ne trouve pas comment utiliser la fonction array.
mes clients sont dans la colonne A et pour avancer dans mon "apprentissage", je voudrais juste que si je tape le nom d'un client dans la msgbox, il me donne la valeur correspondant dans la colonne O. (on verra après pour les résultats multiples)

Code:
Sub recup_donnees()

Dim tab_donnees()
Dim tab_recup()

Dim derligne_donnees As Integer

Dim client_cherche As String

derligne_donnees = Sheets("Gestion des installations").Range("A:A").End(xlDown).Row
ReDim tab_donnees(derligne_donnees, 4)

    For i = 1 To n
        tab_donnees(i, 0) = Sheets("Gestion des installations").Range("A" & i)
        tab_donnees(i, 1) = Sheets("Gestion des installations").Range("N" & i)
        tab_donnees(i, 2) = Sheets("Gestion des installations").Range("O" & i)
        tab_donnees(i, 3) = Sheets("Gestion des installations").Range("M" & i)
    
    Next
    


client_cherche = Application.InputBox("client ?")
' c'est la que je bloque
MsgBox ("matériel")

Next


End Sub
 

drul

Obscur pro du hardware
Staff
Salut, pour le cas cité ici, un dictionnary serait plus approprié qu'un tableau, mais rien d'infaisable,
Il suffit ici de parcourir ton tableau à la recherche de client_cherche:

Code:
client_cherche = Application.InputBox("client ?")
' c'est la que je bloque
    For i = LBound(tab_donnees, 1) To UBound(tab_donnees, 1)
        If tab_donnees(i, 0) = client_cherche Then
            MsgBox ("matériel: " & tab_donnees(i, 2))
        Exit For 'on sort de la boucle
    Next
 

Mickoik

Habitué
Hello,
j'ai tapé ça mais ça ne marche pas :
Code:
'recherche du matériel
Dim tab_donnees()
Dim tab_recup()

Dim derligne_donnees As Integer



derligne_donnees = Sheets("Gestion des installations").Range("O" & Rows.Count).End(xlUp).Row

ReDim tab_donnees(derligne_donnees, 4)

    For i = 1 To derligne_donnees
        tab_donnees(i, 0) = Sheets("Gestion des installations").Range("A" & i)
        tab_donnees(i, 1) = Sheets("Gestion des installations").Range("N" & i)
        tab_donnees(i, 2) = Sheets("Gestion des installations").Range("O" & i)
        tab_donnees(i, 3) = Sheets("Gestion des installations").Range("M" & i)
    
    Next
    
For i = LBound(tab_donnees, 1) To UBound(tab_donnees, 1)
For j = 1 To j = 30
If clientbox.text = tab_donnees(i, 0) Then
Me.listMatos.AddItem
Me.listMatos.List(j, 0) = tab_donnees(i, 1).Value 'qté
Me.listMatos.List(j, 1) = tab_donnees(i, 2).Value 'matos
Me.listMatos.List(j, 2) = tab_donnees(i, 3).Value 'date
j = j + 1
Exit For
Exit For
End If
Next
Next
après il faudra le trier proprement mais déjà que ça charge la list box ...
 

drul

Obscur pro du hardware
Staff
Quelques horreurs là ...
1°) for j = 1 to 30 (pas: j=1 to j= 30)
2°) tu boucle sur j, mais tu fais quand même j=j+1 ???
3°) tu fais j = j + 1 mais tu sors de la boucle ...

Pas bien compris ce que j est censé représenter ici ...
 

Mickoik

Habitué


ça représente la ligne de ma listbox
 

drul

Obscur pro du hardware
Staff
Je comprends pas pourquoi tu veux boucler sur toutes les lignes de ta listbox ...
Stp met un ou printscreen, c'est un peu flou là ...
 

Mickoik

Habitué


en fait j'ai un tableau dans une page "Gestion des installations"
en colonne A le nom du client
en face en colonne M la date d'installation
en N qté
en O matériel

le but de la macro : (première étape) :
pour chaque fois que le client cherché dans une textbox apparaît dans le tableau gestion des installations, je charge la listbox avec autant de lignes que de fois où le client apparaît en A

PS la feuille "Gestion des installation a été transformée en tableau variable pour plus de rapidité

 

Mickoik

Habitué
en tâtonnant, j'ai écris ceci qui marche pas trop :
Code:
'recherche du matériel
Dim tab_donnees()
Dim tab_recup()

Dim derligne_donnees As Integer


' je recupère ma base
derligne_donnees = Sheets("Gestion des installations").Range("O" & Rows.Count).End(xlUp).Row

ReDim tab_donnees(derligne_donnees, 8)

    For i = 1 To derligne_donnees
        tab_donnees(i, 0) = Sheets("Gestion des installations").Range("A" & i)
        tab_donnees(i, 1) = Sheets("Gestion des installations").Range("N" & i)
        tab_donnees(i, 2) = Sheets("Gestion des installations").Range("O" & i)
        tab_donnees(i, 3) = Sheets("Gestion des installations").Range("M" & i)
        tab_donnees(i, 4) = Sheets("Gestion des installations").Range("P" & i)
        tab_donnees(i, 5) = Sheets("Gestion des installations").Range("Q" & i)
        tab_donnees(i, 6) = Sheets("Gestion des installations").Range("R" & i)
        tab_donnees(i, 7) = Sheets("Gestion des installations").Range("S" & i)
    
    Next

' je compte le nombre de ligne de mon tableau resultats
For i = LBound(tab_donnees, 1) To UBound(tab_donnees, 1)
If clientbox = tab_donnees(i, 0) Then
n = n + 1
End If
Next

' je charge mon tableau de resultats
Dim derligne_recup As Integer
derligne_recup = n

ReDim tab_recup(derligne_recup, 8)

For i = LBound(tab_donnees, 1) To UBound(tab_donnees, 1)
For k = 1 To derligne_recup
If clientbox = tab_donnees(i, 0) Then

tab_recup(k, 0) = tab_donnees(i, 3)
End If
Next
Next
listMatos.List = tab_recup

End Sub
 

drul

Obscur pro du hardware
Staff
Question ? tu peux pas vider ta listbox à chaque fois et la reconstruire complétement ?
Ce serait bien plus simple que ce que tu essaies de faire là ...
 

drul

Obscur pro du hardware
Staff
Un truc comme ça quoi:
Code:
Sub test()


Dim tab_donnees()
 
Dim derligne_donnees As Integer

 
 
' je recupère ma base

derligne_donnees = Sheets("Gestion des installations").Range("O" & Rows.Count).End(xlUp).Row

 
ReDim tab_donnees(derligne_donnees, 8)

 
For i = 1 To derligne_donnees

    tab_donnees(i, 0) = Sheets("Gestion des installations").Range("A" & i)

    tab_donnees(i, 1) = Sheets("Gestion des installations").Range("N" & i)

    tab_donnees(i, 2) = Sheets("Gestion des installations").Range("O" & i)

    tab_donnees(i, 3) = Sheets("Gestion des installations").Range("M" & i)

    tab_donnees(i, 4) = Sheets("Gestion des installations").Range("P" & i)

    tab_donnees(i, 5) = Sheets("Gestion des installations").Range("Q" & i)

    tab_donnees(i, 6) = Sheets("Gestion des installations").Range("R" & i)

    tab_donnees(i, 7) = Sheets("Gestion des installations").Range("S" & i)


Next

 
' je compte le nombre de ligne de mon tableau resultats

listMatos.Clear

For i = LBound(tab_donnees, 1) To UBound(tab_donnees, 1)

    If clientbox = tab_donnees(i, 0) Then
    
        listMatos.AddItem tab_donnees(i, 3), listMatos.ListCount
    
    End If

Next

 

 

End Sub
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Derniers messages publiés
Statistiques globales
Discussions
730 098
Messages
6 717 055
Membres
1 586 282
Dernier membre
Yannick3553
Partager cette page
Haut