XL 2016 n plus grand nombres dun tableau

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
 

job75

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

  • N plus grands(1).xlsm
    20.1 KB · Affichages: 6

aurelio.ewane

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

aurelio.ewane

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

  • Esaurelien.xlsx
    97.8 KB · Affichages: 4

aurelio.ewane

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

  • Esaurelien.xlsx
    97.8 KB · Affichages: 5

job75

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

  • Esaurelien(1).xlsm
    29.5 KB · Affichages: 7
Dernière édition:

job75

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

  • Esaurelien(2).xlsm
    28.8 KB · Affichages: 3

Discussions similaires

  • Question
Microsoft 365 #N/A
Réponses
6
Affichages
205

Statistiques des forums

Discussions
311 725
Messages
2 081 945
Membres
101 849
dernier inscrit
florentMIG