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

Public Sub NgrandeValeur()                ' colorier les N grandes valeurs de gauche à droite (notez que la Sub est publique)
Dim t, i&, j&, k&, N&, valeur, nbr&, max
   With Me                                ' avec la feuille courante (Feuil1)
      Application.ScreenUpdating = False  ' on fige l'écran (plus rapide)
      t = .Range("a1").CurrentRegion: N = .Range("aa1")     ' lecture des valeurs du tableau et de N
      .Range("b2").Resize(UBound(t) - 1, UBound(t, 2) - 1).Interior.ColorIndex = xlColorIndexNone  ' sans fond de couleur
      For i = 2 To UBound(t)                                ' pour chaque ligne du tableau t
         nbr = 0                                            ' nombre de cellules de la ligne i déjà coloriées
         For k = 1 To N                ' pour chaque cellule à colorier
            max = -1E+100              ' max est mis à un nombre négatif (très très petit)
            For j = 2 To UBound(t, 2)  ' on parcourt la ligne i de t
               If t(i, j) <> "" Then If t(i, j) > max Then max = t(i, j)   ' calcul du max de la ligne i
            Next j
            For j = 2 To UBound(t, 2)  ' on parcourt la ligne i de t
               ' si t(i,j) n'est pas vide alors si t(i,j) vaut max, on incrémente le nombre de cellules colorées
               ' et on colore la cellule correspondante et on met t(i,j) à vide - t(i,j n'est plus à traité par la suite
               If t(i, j) <> "" Then If t(i, j) >= max Then nbr = nbr + 1: .Cells(i, j).Interior.Color = vbGreen: t(i, j) = ""
               If nbr = N Then Exit For   ' si nbr (nombre de cellules déjà colorées) vaut N alors on quitte la boucle des colonnes
            Next j
            If nbr = N Then Exit For      ' si nbr (nombre de cellules déjà colorées) vaut N alors on a terminé de colorier le
         Next k                           ' nombre désiré de cellules à colorier et on quitte la boucle de coloriage
      Next i
   End With
End Sub

=(C7<>"")*(EQUIV(C7-COLONNE()/1000000;GRANDE.VALEUR($C7:$Z7-COLONNE($C7:$Z7)/1000000;COLONNE($C7:$Z7)-COLONNE($B7));0)<=$B$2)

=LIGNE()-LIGNE(Tableau1[#En-têtes])

Sub tri(a, gauc, droi)          ' Quick sort 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(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


Sub OrdonneSh()
     Dim Tb()
     nb = 0
     For Each Wsh In ThisWorkbook.Worksheets
          If UCase(Wsh.Name) Like "CLASS*" Then
               nb = nb + 1
               ReDim Preserve Tb(1 To 2, 1 To nb)
               part = Split(Wsh.Name, " ")
               Tb(1, nb) = Wsh.Name
               If UBound(part) = 1 Then
                    Tb(2, nb) = CInt(part(1))
               End If
          End If
     Next
     Call tri(Tb, 1, UBound(Tb, 2))
     ThisWorkbook.Worksheets(Tb(1, 1)).Move Before:=ThisWorkbook.Worksheets(1)
     For i = 2 To UBound(Tb, 2)
          ThisWorkbook.Worksheets(Tb(1, i)).Move After:=ThisWorkbook.Worksheets(Tb(1, i - 1))
     Next
     Application.Goto ThisWorkbook.Worksheets(Tb(1, 1)).[A1]

End Sub

Public Sub NgrandeValeur()                ' colorier les N grandes valeurs de gauche à droite (notez que la Sub est publique)
Dim t, Ncell&, i&, nv&, j&, k&, ech As Boolean, x, n&, couleur
   With Me                                ' avec la feuille courante (Feuil1)
      Application.ScreenUpdating = False  ' on fige l'écran (l'affichage est plus rapide)
      t = .Range("a1").CurrentRegion: Ncell = .Range("aa1")     ' lecture des valeurs du tableau et de N
      couleur = .Range("aa1").Interior.Color                              ' couleur du fond à utiliser
      .Range("b2").Resize(UBound(t) - 1, UBound(t, 2) - 1).Interior.ColorIndex = xlColorIndexNone  ' sans fond de couleur
      ' on déclare un tableau v des valeurs d'une ligne et de leur indice au sein de la ligne
      ReDim v(1 To UBound(t, 2) - 1): ReDim a(1 To UBound(v))
      For i = 2 To UBound(t)                                ' pour chaque ligne du tableau t,on remplit les tableaux v et a
         nv = 0                                             ' nv = nombre de valeurs de la ligne (au départ 0)
         For j = 2 To UBound(t, 2)                          ' pour chaque colonne de la ligne i du tableau t
            If t(i, j) <> "" Then nv = nv + 1: v(nv) = t(i, j): a(nv) = j  ' on stocke la valeur dans v et son index dans a
         Next j
         ' Tri de v et a (du plus grand au plus petit avec un tri à bulle car c'est un tri stable)
         Do                      ' boucle infinie
            ech = False          ' initialisation de l'indicateur d'échange pour un tour (au départ aucun échange)
            For k = 1 To nv - 1  ' depuis le premier élément de v jusqu'au dernier moins 1
               ' si l'élément k est inf. à l'élément k+1, on inverse les éléments ket k+1 de v (et a) et ech est true
               If v(k) < v(k + 1) Then x = v(k): v(k) = v(k + 1): v(k + 1) = x: x = a(k): a(k) = a(k + 1): a(k + 1) = x: ech = True
            Next k
         Loop While ech          ' Tant qu'on a fait au moins un échange on refait un tour - sinon le tri est terminé
         If Ncell > nv Then n = nv Else n = Ncell   ' nbre de cellules à colorier (le max étant nv : nombre de valeurs de la ligne)
         For j = 1 To n: .Cells(i, a(j)).Interior.Color = couleur: Next      ' coloriage
      Next i
   End With
End Sub