XL 2016 n plus grand nombres dun tableau

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 !

Bonsoir esaurelien, JHA,

Voyez le fichier joint et ce code :
VB:
Sub N_plus_grands()
Dim N, deb As Range, tablo, ub%, i&, j%, a(), b(), nn
N = Int(Val([G2]))
If N <= 0 Then Exit Sub
Set deb = [A1]
tablo = deb.CurrentRegion 'matrice, plus rapide
ub = UBound(tablo, 2)
For i = 1 To UBound(tablo)
    For j = 1 To ub
        If IsNumeric(CStr(tablo(i, j))) Then
            ReDim Preserve a(nn)
            ReDim Preserve b(nn)
            a(nn) = CDbl(tablo(i, j))
            b(nn) = deb(i, j).Address(0, 0)
            nn = nn + 1
        End If
Next j, i
tri a, b, 0, nn - 1
'---restitution---
If N > nn Then N = nn
With [I2] '1ère cellule de destination
    If N Then
        .Resize(N) = Application.Transpose(a) 'Transpose est limitée à 65536 lignes
        .Offset(, 1).Resize(N) = Application.Transpose(b)
    End If
    .Offset(N).Resize(Rows.Count - N - .Row + 1, 2).ClearContents 'RAZ en dessous
End With
End Sub

Sub tri(a, b, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) > ref: g = g + 1: Loop
    Do While ref > a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      temp = b(g): b(g) = b(d): b(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, b, g, droi)
If gauc < d Then Call tri(a, b, gauc, d)
End Sub
A+
 

Pièces jointes

Bonsoir esaurelien, JHA,

Voyez le fichier joint et ce code :
VB:
Sub N_plus_grands()
Dim N, deb As Range, tablo, ub%, i&, j%, a(), b(), nn
N = Int(Val([G2]))
If N <= 0 Then Exit Sub
Set deb = [A1]
tablo = deb.CurrentRegion 'matrice, plus rapide
ub = UBound(tablo, 2)
For i = 1 To UBound(tablo)
    For j = 1 To ub
        If IsNumeric(CStr(tablo(i, j))) Then
            ReDim Preserve a(nn)
            ReDim Preserve b(nn)
            a(nn) = CDbl(tablo(i, j))
            b(nn) = deb(i, j).Address(0, 0)
            nn = nn + 1
        End If
Next j, i
tri a, b, 0, nn - 1
'---restitution---
If N > nn Then N = nn
With [I2] '1ère cellule de destination
    If N Then
        .Resize(N) = Application.Transpose(a) 'Transpose est limitée à 65536 lignes
        .Offset(, 1).Resize(N) = Application.Transpose(b)
    End If
    .Offset(N).Resize(Rows.Count - N - .Row + 1, 2).ClearContents 'RAZ en dessous
End With
End Sub

Sub tri(a, b, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) > ref: g = g + 1: Loop
    Do While ref > a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      temp = b(g): b(g) = b(d): b(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, b, g, droi)
If gauc < d Then Call tri(a, b, gauc, d)
End Sub
A+
Bonjour
je vais essayer de joindre un fichier
merci pour vos retour
 
Voila le fichier joint

Mo tableau va aller de F3 à AP86 donc il est variable. Les données de ce tableau sont issus d'un autre tableau donc seront dynamique..
le tableau a toujours 84 lignes de la ligne 3 à la ligne 86
pour les colonnes évidement ce sera dynamique commençant à F et pouvant évoluer jusqu'à AP...

Mon problème est donc le suivant
J'aimerais appliquer une mise en forme particulière sur les plus cellules comportant les plus grandes valeurs sur chaque ligne.

Par exemple nous supposons pour le cas de qui est dans le fichier
par exemple je peux avoir besoin de mettre en gras tous les 2 plus grands nombre des chaque ligne ou tous les 3 plus grands nombres etc...

donc le nombre de plus grand termes est Variable...

jespere que je suis fais comprendre

Merci encore pour vos efforts.
 

Pièces jointes

Bonjour à tous,

Peut-être comme cela.

JHA
Voila le fichier joint

Mo tableau va aller de F3 à AP86 donc il est variable. Les données de ce tableau sont issus d'un autre tableau donc seront dynamique..
le tableau a toujours 84 lignes de la ligne 3 à la ligne 86
pour les colonnes évidement ce sera dynamique commençant à F et pouvant évoluer jusqu'à AP...

Mon problème est donc le suivant
J'aimerais appliquer une mise en forme particulière sur les plus cellules comportant les plus grandes valeurs sur chaque ligne.

Par exemple nous supposons pour le cas de qui est dans le fichier
par exemple je peux avoir besoin de mettre en gras tous les 2 plus grands nombre des chaque ligne ou tous les 3 plus grands nombres etc...

donc le nombre de plus grand termes est Variable...

jespere que je suis fais comprendre

Merci encore pour vos efforts.
 

Pièces jointes

Bonjour esaurelien, JHA,

Voyez le fichier joint et cette macro affectée au bouton :
VB:
Sub Police()
Dim N, P As Range, ordre, r As Range, memo
N = Int(Val([G1]))
If N <= 0 Then Exit Sub
Set P = [F3:AP86] 'à adapter
If N > P.Columns.Count Then N = P.Columns.Count
Application.ScreenUpdating = False
P.Font.Bold = False
P.Font.ColorIndex = xlAutomatic
ordre = P.Rows(0)
For Each r In P.Rows
    memo = r(0) 'mémorise
    r(0) = ordre
    r(0).Resize(2).Sort r, xlDescending, Header:=xlNo, Orientation:=2 '1er tri horizontal
    r.Resize(, N).Font.Bold = True 'gras
    r.Resize(, N).Font.Color = vbRed 'police rouge
    r(0).Resize(2).Sort r(0), xlAscending, Header:=xlNo, Orientation:=2 '2ème tri horizontal
    r(0) = memo
Next
End Sub
A+
 

Pièces jointes

Dernière édition:
Bonjour esaurelien, JHA, le forum,

Bien entendu on peut se passer du bouton, voyez cette macro dans le code de la feuille :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim N, P As Range, ordre, r As Range, memo
N = Int(Val([G1]))
Set P = [F3:AP86] 'à adapter
If N > P.Columns.Count Then N = P.Columns.Count
Application.ScreenUpdating = False
P.Font.Bold = False
P.Font.ColorIndex = xlAutomatic
If N <= 0 Then Exit Sub
ordre = P.Rows(0)
Application.EnableEvents = False 'désactive les évènements
For Each r In P.Rows
    memo = r(0) 'mémorise
    r(0) = ordre
    r(0).Resize(2).Sort r, xlDescending, Header:=xlNo, Orientation:=2 '1er tri horizontal
    r.Resize(, N).Font.Bold = True 'gras
    r.Resize(, N).Font.Color = vbRed 'police rouge
    r(0).Resize(2).Sort r(0), xlAscending, Header:=xlNo, Orientation:=2 '2ème tri horizontal
    r(0) = memo
Next
Application.EnableEvents = True 'réactive les évènements
End Sub
Elle se déclenche quand on modifie une cellule quelconque.

A+
 

Pièces jointes

- 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

Réponses
1
Affichages
41
Réponses
11
Affichages
74
Réponses
10
Affichages
272
Réponses
4
Affichages
97
Retour