XL 2013 Ajout hiérarchie dans résultat

Dudesson

XLDnaute Junior
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.
 

Pièces jointes

  • Classeur 1.xlsm
    46.3 KB · Affichages: 9

job75

XLDnaute Barbatruc
Bonjour Dudesson, chris,

Dans la feuille "Planning" sélectionner la cellule H2 et définir le nom matrice par :
Code:
=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 :
Code:
=SIERREUR(INDEX(Stocks!$E$4:$E$1000;EQUIV(PETITE.VALEUR(matrice;NB.SI(G$2:G2;G2));matrice;0));"")
A+
 

Pièces jointes

  • Classeur(1).xlsm
    34.6 KB · Affichages: 3

Dudesson

XLDnaute Junior
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
 

job75

XLDnaute Barbatruc
donc si possible, une solution en Vba.
Pas de problème, voyez ce fichier (2) et la macro du bouton :
VB:
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.
 

Pièces jointes

  • Classeur(2).xlsm
    34.5 KB · Affichages: 7
Dernière édition:

job75

XLDnaute Barbatruc
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 :
VB:
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.
 

Pièces jointes

  • Classeur(3).xlsm
    33.2 KB · Affichages: 3

Discussions similaires

Réponses
6
Affichages
302
Réponses
6
Affichages
266

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 846
dernier inscrit
Silhabib