Ranking et Tri automatique en ligne

Bonjour à tous ,

Je travaille dans le transport et je voudrais effectuer un ranking des fournisseurs en fonction de leurs tarifs .

mon tableau source a une structure identique à celui-ci :

CODE Colis Depart Arrivée Fournisseur1 Fournisseur2 Fournisseur3 Fournisseur4 Fournisseur5 Fournisseur6

1 Pommes Lyon Paris 100,00 € 101,00 € 98,00 € 94,00 € 105,00 € 97,00 €

2 Poires Nantes Lyon 98,00 € 94,00 € 100,00 € 102,00 € 94,00 € 98,00 €

3 Fraises Bordeaux Nantes 130 129 135 134 129 128

4 Orange Paris Bordeaux 98 100 97 95 100 101

Dans une premiere phase , je voudrais en VBA effectuer un ranking ( Fournisseur le moins cher est de niveau 1)par relation sous cette forme :

CODE Colis Depart Arrivée Fournisseur1 Fournisseur2 Fournisseur3 Fournisseur4 Fournisseur5 Fournisseur6

1 Pommes Lyon Paris 4 5 3 1 6 2

2 Poires Nantes Lyon 3 1 5 6 1 3 ETC.....

J' y suis arrivé par les formules Excel, mais cela doit etre réalisable en VBA , non ?

Comme mon tableau reel comporte une centaine de relations et +/- 50 fournisseurs, je voudrais pouvoir trier individuellement chaque ligne du tableau de ranking .

Par exemple , si je suis interréssé par la ligne 1 je clique sur 1 ou Pommes ou Lyon ou Paris , et tout mon tableau subit un tri horizontal d'apres la ligne 1 :

TRI

CODE Colis Depart Arrivée Fournisseur4 Fournisseur6 Fournisseur3 Fournisseur1 Fournisseur2 Fournisseur5

1 Pommes Lyon Paris 1 2 3 4 5 6

2 Poires Nantes Lyon 6 3 5 3 1 1

Etc

5classeur1.xlsx (11.55 Ko)

Vu mon niveau en VBA , je suis perdu . quelqu'un a une idée ?

merci de votre aide

Bonjour,

bonjour, une solution via une macro événementielle.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Column > 4 Then Exit Sub
    Application.EnableEvents = False
    dl = Cells(Rows.Count, 1).End(xlUp).Row
    dc = Cells(3, Columns.Count).End(xlToLeft).Column
    Cells(3, 5).Resize(dl - 2, dc).Sort key1:=Cells(Target.Row, 5), order1:=xlAscending, Orientation:=2, Header:=xlNo
    Cells(Target.Row, 1).Resize(, dc).Select
    Application.EnableEvents = True
End Sub

il suffit de cliquer sur une des cellules des 4 premières colonnes pour avoir le tableau trié suivant les prix de cette ligne. Pour avoir le tableau trié par fournisseur cliquer sur une des 4 premières cellules de la ligne d'entête

5wence.xlsm (16.87 Ko)

Bravo pour ton travail et ta rapidité .

Cela fonctionne à merveille !!!

un grand merci à toi !

C'est encore moi.

Sur le principe cela fonctionne bien , sauf si je clique dans les colonnes A , B , C ,D au dessus ou au dessous du tableau => j'ai un message "référence de tri non valide"

Comment puis je limiter l'action a certaines lignes ?

merci

C'est tout bon !!

j'ai jouté 2 lignes :

" If Target.Row < 3 Then Exit Sub

If Target.Row > 130 Then Exit Sub "

merci

Bonjour,

Une autre proposition à étudier.

Cdlt.

6classeur1.xlsm (28.32 Ko)

re-bonjour,

Sur le principe cela fonctionne bien , sauf si je clique dans les colonnes A , B , C ,D au dessus ou au dessous du tableau => j'ai un message "référence de tri non valide"

voici une manière de faire

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Column > 4 Then Exit Sub
    dl = Cells(Rows.Count, 1).End(xlUp).Row
    If Target.Row < 3 Then Exit Sub
    If Target.Row > dl Then Exit Sub
    Application.EnableEvents = False
    dl = Cells(Rows.Count, 1).End(xlUp).Row
    dc = Cells(3, Columns.Count).End(xlToLeft).Column
    Cells(3, 5).Resize(dl - 2, dc).Sort key1:=Cells(Target.Row, 5), order1:=xlAscending, Orientation:=2, Header:=xlNo
    Cells(Target.Row, 1).Resize(, dc).Select
    Application.EnableEvents = True
End Sub

en effet , c'est plus propre .

Merci

Rechercher des sujets similaires à "ranking tri automatique ligne"