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

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
A

aurelio.ewane

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

Pièces jointes

Trier par date Trier par votes
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°
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
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) ?
Cliquez pour agrandir...
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.
 
Vote positif 0 Vote négatif
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°
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
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.
 
Dernière édition:
Vote positif 0 Vote négatif
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.
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
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
Cliquez pour agrandir...
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
Cliquez pour agrandir...
C'est ce que j'ai fait dans la nouvelle version dont je parle ci-dessus
À ce soir
 
Vote positif 0 Vote négatif
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
 

Pièces jointes

Vote positif 0 Vote négatif
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
 

Pièces jointes

Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

A
  • Résolu(e)
Microsoft 365 programme VBA pour "importer" les valeurs de certaines cellules d'une autre feuille appartenant à une ligne que j'identifie par un n°
2
Réponses
27
Affichages
873
arnomorize
A
KTM
  • Question Question
XL 2019 Arrondir les valeurs décimales d'une plage à l'entier supérieur.
2
Réponses
22
Affichages
865
Laurent78
L
D
  • Résolu(e)
XL 2016 remplir cellule avec plusieurs valeurs issues d'une plage selon critère
Réponses
12
Affichages
1 K
dav30029
D
R
  • Résolu(e)
Microsoft 365 Copier les valeurs d'une cellule après une RECHERCHEV si vide
2
Réponses
26
Affichages
2 K
r3vzone
R
A
  • Question Question
XL 2016 Retrouver les valeurs d'une plage de cellule avec des critères prédéfinis
2
Réponses
16
Affichages
2 K
album40
A
B
  • Résolu(e)
XL 2019 Diviser les valeurs des lignes d'une plage par un nombre à partir d'une cellule
Réponses
7
Affichages
1 K
Bidexcel
B
A
  • Question Question
XL 2016 Comparer les valeurs d'une plage de cellule à une ligne .
Réponses
8
Affichages
1 K
album40
A
R
  • Question Question
VBA ; recherche de valeurs mini sur une plage de façon dynamique
2 3
Réponses
30
Affichages
5 K
Raka
R
papillondelumiere
  • Résolu(e)
Microsoft 365 Supprimer les blancs se trouvant à la fin d'une liste en cascade
2
Réponses
17
Affichages
4 K
papillondelumiere
papillondelumiere
laurent950
  • Résolu(e)
XL 2013 Redim Preserve Variable Tableau Emboité = Erreur 9 (Indice hors plage)
2 3
Réponses
36
Affichages
5 K
patricktoulon
patricktoulon
A
  • Question Question
XL 2016 Remplir un tableau selon les valeurs de cellules dispersées sur une feuille Excel.
Réponses
7
Affichages
2 K
Astyanax
A
J
  • Question Question
MACRO QUI CHANGE AUTOMATIQUEMENT LES VALEURS D'UNE CELLULE ET RECOPIE LES RESULTATS AFFICHEES
Réponses
7
Affichages
1 K
chris
chris
I
  • Question Question
XL 2013 Utiliser feuil excel comme formulaire et copié les valeurs vers une autre
Réponses
1
Affichages
1 K
Bebere
B
F
  • Question Question
XL 2013 Lister valeurs d'une plage 1 associées aux valeurs d'une plage 2
Réponses
2
Affichages
950
florence33
F
J
  • Question Question
VBA pou archiver les valeurs d'une cellule à la fin de la journée
Réponses
1
Affichages
1 K
xylomyd
X
P
  • Question Question
Trouver les entêtes de colonne d'après les valeurs Max et Min d'une ligne
Réponses
5
Affichages
2 K
Pierredlv88
P
M
  • Question Question
VBA, Dans excel 2007 : Colorer cellules lorque 3 valeurs identiques succesives
Réponses
5
Affichages
1 K
Lolote83
L
paskikic
  • Question Question
rechercher les 5 plus grandes valeurs d'une colonne
Réponses
3
Affichages
2 K
jpb388
jpb388
P
  • Question Question
Utiliser la valeur des cellules d'une plage pour désigner une feuille précise
Réponses
2
Affichages
60 K
pericles
P
A
  • Question Question
ne pas montrer toutes les valeurs d'une colonne dans un combobox
Réponses
0
Affichages
1 K
avenir80
A
Retour