aurelio.ewane
XLDnaute Occasionnel
J'ai un tableau contenant des données numériques
comment faire pour récupérer les n plus grands ainsi que leur position
comment faire pour récupérer les n plus grands ainsi que leur position
=NB.SI($F3:F3;F3)<=SOMME(N(GRANDE.VALEUR($F3:$AP3;LIGNE(INDIRECT("1:"&$G$1)))=F3))
Bonnjour jai bien vu votre Reponse et je vous remercie pour cela.... en fait mes données reeles ont des lettres et des chiffres et lidée cest de pourvoir recchercher les plus grandes valeurs sur chaque ligne et les Quadriller comme sur lexmple...J'ai eu du mal mais je suis arrivé à trouver une solution par MFC (Mise en forme conditionnelle).
Sur F3:AP86 :
Attention votre fichier était en mode de calcul Manuel, je l'ai mis en Automatique.Code:=NB.SI($F3:F3;F3)<=SOMME(N(GRANDE.VALEUR($F3:$AP3;LIGNE(INDIRECT("1:"&$G$1)))=F3))
J'ai eu du mal mais je suis arrivé à trouver une solution par MFC (Mise en forme conditionnelle).
Sur F3:AP86 :
Attention votre fichier était en mode de calcul Manuel, je l'ai mis en Automatique.Code:=NB.SI($F3:F3;F3)<=SOMME(N(GRANDE.VALEUR($F3:$AP3;LIGNE(INDIRECT("1:"&$G$1)))=F3))
Private Sub Worksheet_Change(ByVal Target As Range)
Dim N, P As Range, ncol%, ordre, r As Range, memo, a, i%, v, x$, j%, c As Range
N = Int(Val([G1]))
Set P = [F3:AP86] 'à adapter
If N > P.Columns.Count Then N = P.Columns.Count
Application.ScreenUpdating = False
P.Borders(xlDiagonalUp).LineStyle = xlNone
P.Interior.ColorIndex = xlNone 'pas de couleur
If N <= 0 Then Exit Sub
ncol = P.Columns.Count
ordre = P.Rows(0)
Application.EnableEvents = False 'désactive les évènements
For Each r In P.Rows
memo = r(0).Resize(2) 'mémorise les 2 lignes
r(0) = ordre
a = r 'matrice, plus raide
For i = 1 To ncol
If Not IsNumeric(a(1, i)) Then
v = a(1, i)
x = ""
For j = 1 To Len(v)
If IsNumeric(Mid(v, j, 1)) Then x = x & Mid(v, j, 1)
Next j
a(1, i) = Val(x)
End If
Next i
r = a
r(0).Resize(2).Sort r, xlDescending, Header:=xlNo, Orientation:=2 '1er tri horizontal
r.Resize(, N).Interior.Color = vbRed 'couleur car les bordures ne suivent pas les tris
r(0).Resize(2).Sort r(0), xlAscending, Header:=xlNo, Orientation:=2 '2ème tri horizontal
r(0).Resize(2) = memo
For Each c In r.Cells
If c.Interior.Color = vbRed Then c.Borders(xlDiagonalUp).Weight = xlThin 'applique les bordures diagonales
Next c
Next
P.Interior.ColorIndex = xlNone 'efface la couleur rouge
Application.EnableEvents = True 'réactive les évènements
End Sub