XL 2010 Colorier les n plus grandes valeurs d'une plage EXCEL

aurelio.ewane · 24 Juillet 2025

Bonjour les excellistes
je suis confronté à un petit soucis
jai une plage qui va de B2:Y201
je voudrais donc pour chacune des lignes de cette plage colorier les cellules qui contiennent les n valeurs les plus grandes valeurs

n dois etre mis dans la cellule AB1 par exemple

mais le rééel soucis cest que lorsque la dans une ligne il ya 02 valeurs identiques, je n'arrive pas à les colorier toutes
je joins mon fichier

cordialment

aurelio.ewane · 25 Juillet 2025

AtTheOne à dit:

Bonjour à toutes & à tous, bonjour @aurelio.ewane
Une solution sans MFC et ne mettant que n cellules en évidence :

VB:

Sub ReHausserTopRang()
   
     Dim WSh As Worksheet, Dc As Object, Rg As Range, CellRang As Range
   
     Set WSh = Feuil1    ' Wsh : la feuille concernée (Feuil1 c'est le CodeName de la feuille)
     Rang = WSh.[AB1]    ' Rang : La valeur contenue dans la cellule AB1  de la feuille WSh
   
     With WSh.[A1].CurrentRegion  ' la zone continue contenant la cellule A1,
                                  ' cette zone doit être séparée du reste de la feuille par une colonne et une ligne vide
          Set Rg = .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1) ' Rg ne contient plus que la plage de données à traiter
     End With
   
     Nbcol = Rg.Columns.Count      'Nombre de colonne dans la plage étudiée
     Application.ScreenUpdating = False
     With Rg
          .Font.Bold = False
          .Interior.Pattern = xlNone
     End With
   
     ReDim TbTRi(1 To 2, 1 To Nbcol)
     For Each Ligne In Rg.Rows
          tb = Ligne
          Min = WorksheetFunction.Min(tb) - 1   'valeur inférieure à toutes les valeurs de la ligne pour placer dans les cellules vides avant le tri
          For i = 1 To Nbcol
               TbTRi(1, i) = i
               If IsEmpty(tb(1, i)) Then
                    TbTRi(2, i) = Min
               Else
                    TbTRi(2, i) = tb(1, i)
               End If
          Next i
          Call tri(TbTRi, 1, Nbcol)
          For i = 1 To Rang
               If TbTRi(2, i) <> Min Then
                    With Ligne.Cells(TbTRi(1, i))
                         .Font.Bold = True
                         .Interior.Color = 13408767
                    End With
               End If
          Next i
         
     Next Ligne
     Application.ScreenUpdating = True
End Sub

Sub tri(a, gauc, droi)          ' Quick sort décroissant  de J. Boisgontier adapté
     ref = a(2, (gauc + droi) \ 2)
     g = gauc: d = droi
     Do
          Do While a(2, g) > ref: g = g + 1: Loop
          Do While ref > a(2, d): d = d - 1: Loop
          If g <= d Then
               Temp = a(2, g): a(2, g) = a(2, d): a(2, d) = Temp
               Temp = a(1, g): a(1, g) = a(1, d): a(1, 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

Voir fichier Joint
À bientôt

Edit: il faut ajouter une deuxième clef de tri (sur les N°) si l'on veut s'assurer, quand il y a des doublon de prendre les premiers dans l'ordre des N°

Un Grand Bravooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
reste a comprendre tous ca

une question cepandant

cette sequence de code
With WSh.[A1].CurrentRegion ' la zone continue contenant la cellule A1,
' cette zone doit être séparée du reste de la feuille par une colonne et une ligne vide
Set Rg = .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1) ' Rg ne contient plus que la plage de données à traiter
End With

ne peut pas etre remplacée par

Set Rg=Wsh.range(B2:Y201) ?

juste une question puisque dans le fichier final il yaura dautres colonnes directement àprès Y qui seront utilisés

Merci tout de même et bravo

AtTheOne · 25 Juillet 2025

re

aurelio.ewane à dit:
cette sequence de code
With WSh.[A1].CurrentRegion ' la zone continue contenant la cellule A1,
' cette zone doit être séparée du reste de la feuille par une colonne et une ligne vide
Set Rg = .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1) ' Rg ne contient plus que la plage de données à traiter
End With

ne peut pas etre remplacée par

Set Rg=Wsh.range(B2:Y201) ?

Si mais si tu changes le dimensionnement de ce tableau (plus ou moins de lignes et/ou de colonnes) tu devras modifier cette ligne du code.

aurelio.ewane · 25 Juillet 2025

ma derni

AtTheOne à dit:

Bonjour à toutes & à tous, bonjour @aurelio.ewane
Une solution sans MFC et ne mettant que n cellules en évidence :

VB:

Sub ReHausserTopRang()
 
     Dim WSh As Worksheet, Dc As Object, Rg As Range, CellRang As Range
 
     Set WSh = Feuil1    ' Wsh : la feuille concernée (Feuil1 c'est le CodeName de la feuille)
     Rang = WSh.[AB1]    ' Rang : La valeur contenue dans la cellule AB1  de la feuille WSh
 
     With WSh.[A1].CurrentRegion  ' la zone continue contenant la cellule A1,
                                  ' cette zone doit être séparée du reste de la feuille par une colonne et une ligne vide
          Set Rg = .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1) ' Rg ne contient plus que la plage de données à traiter
     End With
 
     Nbcol = Rg.Columns.Count      'Nombre de colonne dans la plage étudiée
     Application.ScreenUpdating = False
     With Rg
          .Font.Bold = False
          .Interior.Pattern = xlNone
     End With
 
     ReDim TbTRi(1 To 2, 1 To Nbcol)
     For Each Ligne In Rg.Rows
          tb = Ligne
          Min = WorksheetFunction.Min(tb) - 1   'valeur inférieure à toutes les valeurs de la ligne pour placer dans les cellules vides avant le tri
          For i = 1 To Nbcol
               TbTRi(1, i) = i
               If IsEmpty(tb(1, i)) Then
                    TbTRi(2, i) = Min
               Else
                    TbTRi(2, i) = tb(1, i)
               End If
          Next i
          Call tri(TbTRi, 1, Nbcol)
          For i = 1 To Rang
               If TbTRi(2, i) <> Min Then
                    With Ligne.Cells(TbTRi(1, i))
                         .Font.Bold = True
                         .Interior.Color = 13408767
                    End With
               End If
          Next i
       
     Next Ligne
     Application.ScreenUpdating = True
End Sub

Sub tri(a, gauc, droi)          ' Quick sort décroissant  de J. Boisgontier adapté
     ref = a(2, (gauc + droi) \ 2)
     g = gauc: d = droi
     Do
          Do While a(2, g) > ref: g = g + 1: Loop
          Do While ref > a(2, d): d = d - 1: Loop
          If g <= d Then
               Temp = a(2, g): a(2, g) = a(2, d): a(2, d) = Temp
               Temp = a(1, g): a(1, g) = a(1, d): a(1, 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

Voir fichier Joint
À bientôt

Edit: il faut ajouter une deuxième clef de tri (sur les N°) si l'on veut s'assurer, quand il y a des doublons de prendre les premiers dans l'ordre des N°

je precise que jutilise EXCEL 2010
Ma derniere question cest de savoir comment trier les onglets d'un classeurs
je precise que jen ai 27 et parfois plus
je veux les trier par ordre
les classeurs sont nommées
class
class 2
class 20
class 1
class 5
class 5
class 21
class 6
class 8
class 2
class 20
class 11
class 15
class 12
class 18
class 16
class 4

job75 · 25 Juillet 2025

Concernant la solution VBA j'ai voulu voir ce que donne le tri horizontal :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim N%, r As Range, mem, ac%
N = [AB1]
Application.ScreenUpdating = False
Application.EnableEvents = False
With [B2:Y201]
    .Interior.ColorIndex = xlNone: .Font.Bold = False 'RAZ
    For Each r In .Rows
        mem = r(2) 'mémorise
        r(2).Cells(1) = 1: r(2).DataSeries 'numérotation
        r.Resize(2).Sort r, xlDescending, Header:=xlNo, Orientation:=2 'tri horizontal
        ac = Application.Count(r) 'nombre de valeurs
        If ac Then With r.Resize(, IIf(N < ac, N, ac)): .Interior.Color = 13408767: .Font.Bold = True: End With
        r.Resize(2).Sort r(2), xlAscending 'ordre initial
        r(2) = mem
    Next
End With
Application.EnableEvents = True
End Sub

Cette macro s'exécute chez moi en 0,16 seconde, celle de AtTheOne en 0,05 seconde.

aurelio.ewane · 25 Juillet 2025

job75 à dit:

Concernant la solution VBA j'ai voulu voir ce que donne le tri horizontal :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim N%, r As Range, mem
N = [AB1]
Application.ScreenUpdating = False
Application.EnableEvents = False
With [B2:Y201]
    .Interior.ColorIndex = xlNone: .Font.Bold = False 'RAZ
    For Each r In .Rows
        mem = r(2) 'mémorise
        r(2).Cells(1) = 1: r(2).DataSeries 'numérotation
        r.Resize(2).Sort r, xlDescending, Header:=xlNo, Orientation:=2 'tri horizontal
        With r.Resize(, IIf(N < r.Cells.Count, N, r.Cells.Count)): .Interior.Color = 13408767: .Font.Bold = True: End With
        r.Resize(2).Sort r(2), xlAscending 'ordre initial
        r(2) = mem
    Next
End With
Application.EnableEvents = True
End Sub

Cette macro s'exécute chez moi en 0,16 seconde, celle de AtTheOne en 0,05 seconde.

Un petit bemol lorsque veut quelle colore les 03 premiers plus grandes valeurs,
Sil nya que 02 valeurs sur cette colonne ca va colorier 03 cellules ce qui n'est pas correct
merci tout de même jessaie de comprendre tous
ta technique semble cependant interessante

aurelio.ewane · 25 Juillet 2025

AtTheOne à dit:
re

Si mais si tu changes le dimensionnement de ce tableau (plus ou moins de lignes et/ou de colonnes) tu devras modifier cette ligne du code.

oui ca marche jai pu changer
mais une question Puisqe le tableau est variable
lorsque je prends un tableau avec une seule colonne et plusieurs lignes
il ya des erreurs

AtTheOne · 25 Juillet 2025

Re,
Oui @job75 j'avais aussi essayé, sans chronométrer et ça m'avait semblé plus long.
J'ai une version sur mon PC avec un tri à 2 clefs pour privilégier les doublons de plus petits indices, mais là je suis sur mon téléphone.
À tout à l'heure

AtTheOne · 25 Juillet 2025

aurelio.ewane à dit:
sur une ligne elle doit en cas de doublons prendre celui qui viens le premier et non un au hasrad
parceque c'est que fait ton code

Oui, c'est ce que je disais dans mon post :

AtTheOne à dit:
Edit: il faut ajouter une deuxième clef de tri (sur les N°) si l'on veut s'assurer, quand il y a des doublons de prendre les premiers dans l'ordre des

C'est ce que j'ai fait dans la nouvelle version dont je parle ci-dessus
À ce soir

aurelio.ewane · 25 Juillet 2025

Ok

AtTheOne à dit:
Oui, c'est ce que je disais dans mon post :

C'est ce que j'ai fait dans la nouvelle version dont je parle ci-dessus
À ce soir

Okeyy

job75 · 25 Juillet 2025

aurelio.ewane à dit:
Un petit bemol lorsque veut quelle colore les 03 premiers plus grandes valeurs,
Sil nya que 02 valeurs sur cette colonne ca va colorier 03 cellules ce qui n'est pas correct

D'accord, je viens d'ajouter la variable ac dans la macro du post 34, maintenant c'est bon.

aurelio.ewane · 25 Juillet 2025

job75 à dit:
D'accord, je viens d'ajouter la variable ac dans la macro du post 34, maintenant c'est bon.

comment l'avoir

AtTheOne · 25 Juillet 2025

Re,
de retour à la maison ...
Voici une version avec un tri sur deux clef (valeurs dans l'ordre décroissant, index de colonne dans l'ordre croissant)
le code de tri :

VB:

Sub QuickSortColonnes(arr As Variant, ByVal low As Long, ByVal high As Long) 'Quick sort décroissant ligne 2 croissant ligne 1
    Dim i As Long, j As Long
    Dim pivot1 As Variant, pivot2 As Variant
    Dim tmp1 As Variant, tmp2 As Variant

    i = low
    j = high

    pivot1 = arr(2, (low + high) \ 2) ' valeur
    pivot2 = arr(1, (low + high) \ 2) ' n° d'origine

    Do While i <= j
        Do While Comparer(arr(2, i), arr(1, i), pivot1, pivot2) < 0
            i = i + 1
        Loop
        Do While Comparer(arr(2, j), arr(1, j), pivot1, pivot2) > 0
            j = j - 1
        Loop
        If i <= j Then
            ' Échanger les deux colonnes i et j (les deux lignes)
            tmp1 = arr(1, i): tmp2 = arr(2, i)
            arr(1, i) = arr(1, j): arr(2, i) = arr(2, j)
            arr(1, j) = tmp1: arr(2, j) = tmp2
            i = i + 1
            j = j - 1
        End If
    Loop

    If low < j Then QuickSortColonnes arr, low, j
    If i < high Then QuickSortColonnes arr, i, high
    
End Sub

Function Comparer(v1 As Variant, k1 As Variant, v2 As Variant, k2 As Variant) As Long
    ' Compare les valeurs principales (v1, v2), puis secondaire (k1, k2)
     Select Case True
          Case IsEmpty(v1)
               Comparer = Abs(Not IsEmpty(v2))
          Case Else
               Select Case True
                    Case IsEmpty(v2)
                         Comparer = -1
                    Case Else
                         Select Case v1 - v2
                              Case 0
                                   If k1 < k2 Then
                                       Comparer = -1
                                   ElseIf k1 > k2 Then
                                       Comparer = 1
                                   Else
                                       Comparer = 0
                                   End If
                              Case Is < 0
                                    Comparer = 1
                              Case Is > 0
                                   Comparer = -1
                         End Select
               End Select
     End Select
End Function

Le code principal

VB:

Sub ReHausserTopRang()
    
     Dim WSh As Worksheet, ShTemp As Worksheet, Rg As Range, Rang As Integer, NbCol As Integer, TbTri(), Min As Double
    
     Set WSh = Feuil1    ' Wsh : la feuille concernée (Feuil1 c'est le CodeName de la feuille)
     Rang = WSh.[AB1]    ' Rang : La valeur contenue dans la cellule AB1  de la feuille WSh
    
     With WSh.[A1].CurrentRegion  ' la zone continue contenant la cellule A1,
                                  ' cette zone doit être séparée du reste de la feuille par une colonne et une ligne vide
          Set Rg = .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1) ' Rg ne contient plus que la plage de données à traiter
     End With
    
     NbCol = Rg.Columns.Count      'Nombre de colonne dans la plage étudiée
     Application.ScreenUpdating = False
     'Effacer le formatages précédent
     With Rg
          .Font.Bold = False
          .Interior.Pattern = xlNone
     End With
     'Tableau 2 lignes (pour 1ère ligne Index, 2ème ligne valeurs)
     ReDim TbTri(1 To 2, 1 To NbCol)
    
     For Each Ligne In Rg.Rows
          tb = Ligne
          For i = 1 To NbCol
               TbTri(1, i) = i
               TbTri(2, i) = tb(1, i)
          Next i
          
          Call QuickSortColonnes(TbTri, 1, 24)
          
          For i = 1 To Rang
               If Not IsEmpty(TbTri(2, i)) Then
                    With Ligne.Cells(TbTri(1, i))
                         .Font.Bold = True
                         .Interior.Color = 13408767
                    End With
               End If
          Next i
          
     Next Ligne
     Application.ScreenUpdating = True
End Sub

Voir le fichier joint,
à bientôt

AtTheOne · 25 Juillet 2025

re

aurelio.ewane à dit:
lorsque je prends un tableau avec une seule colonne et plusieurs lignes
il ya des erreurs

Oui car dans ce cas "tb" n'est pas un tableau mais une variable, on peut vérifier ça, mais ça n'a pas grand sens car il n'y a qu'une valeur par ligne donc elle serait toujours la plus grande !
À bientôt

job75 · 25 Juillet 2025

Je rappelle que j'ai donné une solution par MFC au post #29.

La mise à jour de la feuille est quasi instantanée => 0,1 millième de seconde.

CHRIS1945 · 25 Juillet 2025

Bonjour à tous,
Si j'ai bien compris, il fallait pouvoir choisir le nombre de plus grandes valeurs.
J'ai revu ma proposition et maintenant tu peux choisir en AA1 le nombre de grande valeur à surligner (0 à 7) S'il faut faire plus, cela ne pose pas de problème.
Le principe est un peu différent :
1 on a un premier tableau technique qui détermine les grandes valeurs de la ligne de 1 à 8
2 on a un deuxième tableau technique qui élimine les doublons du premier
3 on utilise la MEFC sur base du deuxième tableau technique

Ces tableaux techniques peuvent être masqués

A noter que l'on pourrait aisément mettre une couleur différente par niveau de grande valeur.

Si cela ne correspond pas à tous les cas de figure, dites le moi.

A bientôt
Chris

XL 2010 Colorier les n plus grandes valeurs d'une plage EXCEL

aurelio.ewane

XLDnaute Occasionnel

Pièces jointes

aurelio.ewane

XLDnaute Occasionnel

AtTheOne

XLDnaute Accro

aurelio.ewane

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

aurelio.ewane

XLDnaute Occasionnel

aurelio.ewane

XLDnaute Occasionnel

AtTheOne

XLDnaute Accro

AtTheOne

XLDnaute Accro

aurelio.ewane

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

aurelio.ewane

XLDnaute Occasionnel

AtTheOne

XLDnaute Accro

Pièces jointes

AtTheOne

XLDnaute Accro

job75

XLDnaute Barbatruc

CHRIS1945

XLDnaute Occasionnel

Pièces jointes

Discussions similaires

XL 2010 Colorier les n plus grandes valeurs d'une plage EXCEL

XLDnaute Occasionnel

Pièces jointes

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Accro

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Accro

Pièces jointes

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Occasionnel

Pièces jointes

Discussions similaires

Privacy & Transparency

Privacy & Transparency