XL 2016 palmarès (top 10) fournisseurs

[eastwick]

Bonjour à toutes et tous,

Comment établir un classement décroissant des fournisseurs par montant total associé.
J'ai volontairement ici tout mis à 1,00 euro.

Je vous remercie.

 

[eastwick]

Hello,
J'ai rajouté 4 à la valeur de la cellule B124.
Il y a donc 11 "10 premiers"
Un peu moins "simple", peut-être?
Bonne journée

Merci Cousinhub

 

[job75]

Bonjour,

Il y a donc 11 "10 premiers"
Un peu moins "simple", peut-être?

Que veux-tu dire ? J'ai bien indiqué que mes formules permettent de distinguer les ex-aequo.

Il y en a pour les totaux 50 et 48, pour les voir il suffit de tirer vers le bas les formules des colonnes E:F.

A+

 

[eastwick]

Bonjour,

Que veux-tu dire ? J'ai bien indiqué que mes formules permettent de distinguer les ex-aequo.

Il y en a pour les totaux 50 et 48, pour les voir il suffit de tirer vers le bas les formules des colonnes E:F.

A+

Pour moi, c'est ok, je mets la discussion en solutionnée, encore merci

 

[dysorthographie]

Bonjour,
j'y suis allé de mon petit couplet également

 

[eastwick]

Bonjour,
j'y suis allé de mon petit couplet également

Merci dysorthographie

 

[dysorthographie]

Bonjour,

Que veux-tu dire ? J'ai bien indiqué que mes formules permettent de distinguer les ex-aequo.

Il y en a pour les totaux 50 et 48, pour les voir il suffit de tirer vers le bas les formules des colonnes E:F.

A+

Bonjour,
Je suis d'accord, prenon un exemple :
à qualité égale pour 100€ le fournisseur A propose 1 stylo bille et le fournisseur B 100 stylo qu'est-ce qui détermine les ex-aequo ?

Sans précision du demandeur seul l'ordre alphabétique peut déterminer les ex-aequo.

 

[job75]

Bonjour le forum,

Sans précision du demandeur seul l'ordre alphabétique peut déterminer les ex-aequo.

Au post #13 je distingue les ex aequo par leur ordre d'affichage dans le 1er tableau.

Vraiment pour le fun car le VBA me paraît bien inutile voici une fonction personnalisée :

Function ClasseSomme(plage As Range)
Dim nlig&, format1$, format2$, tablo, d As Object, i&, x$, v, a(), n&, nn&
nlig = plage.Rows.Count
format1 = String(Len(Int(Application.Sum(plage))), "0") & ".00" 'donne "0000.00" ici
format2 = String(Len(nlig), "0") 'donne "0000" ici
tablo = plage 'matrice, plus rapide
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 1 To UBound(tablo)
    x = tablo(i, 1): v = tablo(i, 2)
    If x <> "" And IsNumeric(v) Then
        If Not d.exists(x) Then
            d(x) = n 'mémorise la ligne
            ReDim Preserve a(2, n) 'base 0, 3 colonnes transposées
            a(1, n) = x
            n = n + 1
        End If
        nn = d(x)
        a(2, nn) = a(2, nn) + v 'calcul du total
        a(0, nn) = Format(a(2, nn), format1) & Format(nlig - nn, format2) 'ligne alpha qui sera triée
    End If
Next i
tri a, 0, n - 1
ReDim tablo(n - 1, 1) 'base 0, 2 colonnes
For i = 0 To n - 1
    tablo(i, 0) = a(1, i): tablo(i, 1) = a(2, i)
Next i
ClasseSomme = tablo
End Function

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a(0, (gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(0, g) > ref: g = g + 1: Loop
    Do While ref > a(0, d): d = d - 1: Loop
    If g <= d Then
      temp = a(0, g): a(0, g) = a(0, d): a(0, d) = temp
      temp = a(1, g): a(1, g) = a(1, d): a(1, d) = temp
      temp = a(2, g): a(2, g) = a(2, d): a(2, 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

Formule en D3 à copier vers E3 :

=SIERREUR(INDEX(ClasseSomme(Tableau1);LIGNE()-2;COLONNE()-3);"")

La macro Quick sort fait un tri sur 3 colonnes (3 lignes transposées).

Avec 42 formules dans le 2ème tableau la modification d'une cellule du 1er tableau se fait en :

- 0,15 seconde au post #13

- 1,2 seconde sur ce post, c'est 8 fois plus long.,

A+

 

[dysorthographie]

Bonsoir,
@job75 , c'est juste pour te charrier, car quand on tri du plus gros montant au plus petit, qu'est-ce qu'on veut mettre en évidence ?

Le fournisseur qui nous a le plus arnaqué 🥳
Donc le critère d'ex-aequo...

C'est pour cela que j'ai implanter la valeur moyenne, la mine et la maxe pour évaluer un fournisseur ça me semble indispensable.

 

[job75]

@job75 , c'est juste pour te charrier, car quand on tri du plus gros montant au plus petit, qu'est-ce qu'on veut mettre en évidence ?

Faut pas se prendre la tête pour si peu, on classe les fournisseurs par leur chiffre d'affaire, un point c'est tout.

 

[job75]

Bonjour le forum,

En fait il ne faut pas utiliser une fonction personnalisée mais cette macro évènementielle :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tablo, d As Object, i&, x$, v, a(), n&, nn&
tablo = [Tableau1].Value2  '1er tableau structuré, matrice, plus rapide
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 1 To UBound(tablo)
    x = tablo(i, 1): v = tablo(i, 2)
    If x <> "" And IsNumeric(v) Then
        If Not d.exists(x) Then
            d(x) = n 'mémorise la ligne
            ReDim Preserve a(2, n) 'base 0, 3 colonnes transposées
            a(1, n) = x
            n = n + 1
        End If
        nn = d(x)
        a(0, nn) = a(0, nn) + v 'calcul du total
        a(2, nn) = nn 'mémorise la ligne
    End If
Next i
tablo = Empty
If n Then
    tri a, 0, n - 1
    ReDim tablo(n - 1, 2) 'base 0, 3 colonnes
    For i = 0 To n - 1
        tablo(i, 0) = a(1, i): tablo(i, 1) = a(0, i): tablo(i, 2) = a(2, i)
    Next i
End If
'---restitution---
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
With [Tableau2] '2ème tableau structuré
    .Resize(, 3) = tablo
    If n < .Rows.Count Then .Rows(n + 1).Resize(.Rows.Count - n).ClearContents 'RAZ en dessous
    If n Then .Sort .Columns(2), xlDescending, .Columns(3), , xlAscending, Header:=xlYes 'tri sur 2 colonnes
    .ListObject.Resize .ListObject.Range.Resize(, 2) 'redimensionne le tableau
    .Columns(3).EntireColumn.ClearContents
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a(0, (gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(0, g) > ref: g = g + 1: Loop
    Do While ref > a(0, d): d = d - 1: Loop
    If g <= d Then
      temp = a(0, g): a(0, g) = a(0, d): a(0, d) = temp
      temp = a(1, g): a(1, g) = a(1, d): a(1, d) = temp
      temp = a(2, g): a(2, g) = a(2, d): a(2, 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

Elle se déclenche quand on modifie ou valide une cellule quelconque.

Notez que la macro Quick sort effectue un tri sur une matrice de 3 lignes (3 colonnes transposées).

Un tri classique dans la feuille sur 2 colonnes est effectué à la fin sur le 2ème tableau.

L'exécution se fait en 0,022 seconde, en agrandissant Tableau2 sur 680 lignes elle passe à 0,026 seconde.

A+

 

[job75]

Maintenant si l'on veut que les ex aequo soient affichés dans l'ordre alphabétique c'est plus simple, le tri se fait sur 2 lignes :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tablo, d As Object, i&, x$, v, a, b, n&
tablo = [Tableau1].Value2  '1er tableau structuré, matrice, plus rapide
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 1 To UBound(tablo)
    x = tablo(i, 1): v = tablo(i, 2)
    If x <> "" And IsNumeric(v) Then d(x) = d(x) + v
Next i
n = d.Count
tablo = Empty
If n Then
    a = d.items: b = d.keys
    tri a, b, 0, n - 1
    ReDim tablo(n - 1, 1) 'base 0, 2 colonnes
    For i = 0 To n - 1
        tablo(i, 0) = b(i): tablo(i, 1) = a(i)
    Next i
End If
'---restitution---
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
With [Tableau2] '2ème tableau structuré
    .Value = tablo
    If n < .Rows.Count Then .Rows(n + 1).Resize(.Rows.Count - n).ClearContents 'RAZ en dessous
    .Sort .Columns(2), xlDescending, .Columns(1), , xlAscending, Header:=xlYes 'tri sur 2 colonnes, alphabétique sur 1a 1ère
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

Sub tri(a, b, gauc, droi) ' Quick sort
Dim ref, g, d, temp
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
      temp = b(g): b(g) = b(d): b(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, b, g, droi)
If gauc < d Then Call tri(a, b, gauc, d)
End Sub

Et c'est plus rapide => 0,015 seconde.

 

[ChTi160]

Bonjour le Fil,
il est peut être possible , de définir les ex aequo en fonction du Nombre d'émissions !
Exemple : Nombre d'émission 2=50€ , Nombre d'émission 5=50€ , c'est qui le meilleur Lol
Bonne fin de Journée
Cordialement
Jean marie

 

[job75]

il est peut être possible , de définir les ex aequo en fonction du Nombre d'émissions !

Bien sûr que c'est possible mais eastwick a dit :

Comment établir un classement décroissant des fournisseurs par montant total associé.

C'est clair et sans ambigüité.

 

[job75]

J'ajouterai que rien ne dit que les fournisseurs vendent le même produit.

Alors faire des moyennes ou comparer les prix unitaires n'a aucun sens.

 

[dysorthographie]

Bonsoir,
Personnellement je fourni la somme, la moyenne, le min et le Max car avec SQL rien de plus facile, mais effectivement l'énoncé ne parle pas des ex-aequo. J'ai fait un deuxième tri alphabétique cette fois mais il me semble qu'il appartient au demandeur de formuler s'il veut départager les ex-aequo et de quel manière.