XL 2013 Ajout hiérarchie dans résultat

[Dudesson]

bonjour le forum,
bonjour à tous,
je cherche de l'aide pour ajouter une condition de hiérarchie dans les résultats du code du fichier joint.
il trouve les emplacements et les donne dans l'ordre qu'ils sont sur la feuille Stocks, mais je souhaiterais modifier cet ordre pour que l'emplacement qui a la plus petite quantité en colonne H de la feuille stocks soit affichée la première et ainsi de suite.
concrètement : sur feuille planning, pour le lot 192706 (lignes 3 et 4) , il devrait d'abord afficher en colonne H = EL227 (qui n'a qu'une quantité de 5000 (en colonne H de la feuille Stocks) et ensuite ECM81 (qui compte 25000 en colonne H de la feuille Stocks).
il va sans dire que si le lot n'existe qu'une seule fois en colonne G de la feuille Planning, alors le résultat affiché est l'emplacement en colonne E de la feuille Stocks qui a la plus petite quantité en colonne H (de la feuille Stocks).
j'espère avoir été clair et compréhensible dans mes explications.
merci d'avance.
Pedro.

 

[chris]

Bonjour
Il faut ajouter la quantité à tes critères de tri qui actuellement ne comprennes que Magasin, Lot, Date

 

[Dudesson]

Bonjour, actuellement c'est magasin et lot, il faut en effet ajouter le critère de quantité, donc la plus petite Quantité en premier. Merci.

 

[job75]

Bonjour Dudesson, chris,

Dans la feuille "Planning" sélectionner la cellule H2 et définir le nom matrice par :

=SI((Planning!$G2<>"")*(-Stocks!$C$4:$C$1000=-Planning!$G2);Stocks!$H$4:$H$1000+LIGNE(Stocks!$H$4:$H$1000)/"1E6")

La limite 1000 des plages doit être ajustée au besoin.

Formule en H2 :

=SIERREUR(INDEX(Stocks!$E$4:$E$1000;EQUIV(PETITE.VALEUR(matrice;NB.SI(G$2:G2;G2));matrice;0));"")

A+

 

[Dudesson]

Bonjour et merci pour votre proposition je test quand je rentre. Mais dans mon fichier la feuille planning fait plus de 10000 lignes et +/_ 700 lignes sur la feuille stocks, donc si possible, une solution en Vba. Sincères salutations

 

[chris]

RE

Tu as déjà un tri en mémoire dans ta feuille : il suffit de le modifier, éventuellement l'enregistrer avec l'enregistreur pour l'ajouter à ton code.

 

[job75]

donc si possible, une solution en Vba.

Pas de problème, voyez ce fichier (2) et la macro du bouton :

Private Sub CommandButton1_Click()
Dim tablo, d1 As Object, d2 As Object, i&, resu, x As Variant, s, n&
With Sheets("Stocks").[A3].CurrentRegion 'adapter éventuellement
    .Columns(3).Insert xlToRight 'colonne auxiliaire
    .Columns(3) = "=--(""""&RC[1])" 'convertit en nombre ce qui peut être convertit
    .Resize(, 10).Sort .Columns(3), xlAscending, .Columns(9), , xlAscending, Header:=xlYes 'tri sur 2 colonnes
    tablo = .Columns(3).Resize(, 4) 'matrice, plus rapide
    .Columns(3).Delete xlToLeft 'supprime la colonne auxiliaire
End With
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    If IsNumeric(tablo(i, 1)) Then _
        d1(tablo(i, 1)) = d1(tablo(i, 1)) & " " & i 'mémorise les numéros des lignes
Next
With [A1].CurrentRegion.Columns(7).Resize(, 2)
    resu = .Value 'matrice, plus rapide
    For i = 2 To UBound(resu)
        resu(i, 2) = ""
        x = resu(i, 1)
        If IsNumeric(CStr(x)) Then
            x = CDbl(x)
            If d1.exists(x) Then
                d2(x) = d2(x) + 1
                s = Split(d1(x))
                n = d2(x)
                If n <= UBound(s) Then resu(i, 2) = tablo(s(n), 4)
            End If
        End If
    Next
    If FilterMode Then ShowAllData 'si la feuille est filtrée
    .Value = resu 'restitution
End With
End Sub

L'exécution est très rapide car on utilise des tableaux VBA et 2 Dictionary sans boucles imbriquées.

 

[job75]

J'ai testé en recopiant les tableaux sur 10 000 lignes en feuille "Planning" et 700 lignes en feuille "Stocks" :

- recalcul des formules du fichier (1) => 5,7 secondes

- macro du fichier (2) => 0,49 seconde.

 

[Dudesson]

Bonsoir @job,
Désolé pour mon retour tardif.
Un tout grand merci pour votre aide, c'est exactement ce que je cherchais, en plus c'est très rapide comme vous le dites si bien.
Sincères remerciement.
Pedro.

 

[job75]

Bonjour Dudesson, chris, le forum,

Avec ce fichier (3) les numéros des lots sont convertis en textes, c'est indispensable s'ils contiennent des lettres :

Private Sub CommandButton1_Click()
Dim tablo, d1 As Object, d2 As Object, i&, x$, resu, s, n&
With Sheets("Stocks").[A3].CurrentRegion 'adapter éventuellement
    .Columns(3).Insert xlToRight 'colonne auxiliaire
    .Columns(3) = "=""""&RC[1]" 'convertit en texte
    .Resize(, 10).Sort .Columns(3), xlAscending, .Columns(9), , xlAscending, Header:=xlYes 'tri sur 2 colonnes
    tablo = .Columns(3).Resize(, 4) 'matrice, plus rapide
    .Columns(3).Delete xlToLeft 'supprime la colonne auxiliaire
End With
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    x = tablo(i, 1)
    If x <> "" Then d1(x) = d1(x) & " " & i 'mémorise les numéros des lignes
Next
With [A1].CurrentRegion.Columns(7).Resize(, 2)
    resu = .Value 'matrice, plus rapide
    For i = 2 To UBound(resu)
        resu(i, 2) = ""
        x = CStr(resu(i, 1))
        If d1.exists(x) Then
            d2(x) = d2(x) + 1
            s = Split(d1(x))
            n = d2(x)
            If n <= UBound(s) Then resu(i, 2) = tablo(s(n), 4)
        End If
    Next
    If FilterMode Then ShowAllData 'si la feuille est filtrée
    .Value = resu 'restitution
End With
End Sub

La durée d'exécution reste pratiquement la même.

Bonne journée.

 

[Dudesson]

Bonjour et merci Beaucoup @job75
c'est très gentil de votre part.
bien à vous.
Pedro.