Classement sur plusieurs colonnes

mic6259

XLDnaute Occasionnel
Bonjour,
Pourriez-vous classer les notes suivant la pièce jointe vers la plage H3-M32 par exemple le 84 en rouge serait dans H3 ainsi de suite et d'automatiser le résultat car les notes changeront au fur et a mesure.
En formule ou en VBA.
Merci beaucoup
 

Pièces jointes

  • Classeur1.xlsx
    10.6 KB · Affichages: 16

job75

XLDnaute Barbatruc
Bonjour mic6259,

Voyez le fichier joint et cette macro :
VB:
Sub Classer()
Dim P As Range, h&
Set P = [A3:F32] 'à adapter
h = P.Rows.Count
Application.ScreenUpdating = False
[H:M].Clear 'RAZ
P.Columns(1).Resize(, 2).Copy [H3] 'copier-coller
P.Columns(3).Resize(, 2).Copy [H3].Offset(h)
P.Columns(5).Resize(, 2).Copy [H3].Offset(2 * h)
[H3].Resize(3 * h, 2).Sort [I3], xlDescending, [H3], , xlAscending, Header:=xlNo 'tri
[H3].Offset(h).Resize(h, 2).Cut [J3] 'couper-coller
[H3].Offset(2 * h).Resize(h, 2).Cut [L3]
End Sub
A+
 

Pièces jointes

  • Classeur(1).xlsm
    25.3 KB · Affichages: 8

job75

XLDnaute Barbatruc
Re, salut Paf,

Ce fichier (2) évite d'avoir à modifier la macro si le nombre de lignes du tableau source varie :
VB:
Sub Classer()
Dim P As Range, h&
Application.ScreenUpdating = False
[H:M].Clear 'RAZ
Set P = Intersect(Range("A3:F" & Rows.Count), ActiveSheet.UsedRange)
If P Is Nothing Then Exit Sub
h = P.Rows.Count
P.Columns(1).Resize(, 2).Copy [H3] 'copier-coller
P.Columns(3).Resize(, 2).Copy [H3].Offset(h)
P.Columns(5).Resize(, 2).Copy [H3].Offset(2 * h)
[H3].Resize(3 * h, 2).Sort [I3], xlDescending, [H3], , xlAscending, Header:=xlNo 'tri
[H3].Offset(h).Resize(h, 2).Cut [J3] 'couper-coller
[H3].Offset(2 * h).Resize(h, 2).Cut [L3]
End Sub
A+
 

Pièces jointes

  • Classeur(2).xlsm
    25.9 KB · Affichages: 6

Discussions similaires