XL 2016 n plus grand nombres dun tableau

[aurelio.ewane]

J'ai un tableau contenant des données numériques
comment faire pour récupérer les n plus grands ainsi que leur position

 

[JHA]

Bonjour à tous,

Si tu joins un fichier exemple, tu auras certainement des retours.

JHA

 

[JHA]

Bonjour à tous,

Peut-être comme cela.

JHA

 

[job75]

Bonsoir esaurelien, JHA,

Voyez le fichier joint et ce code :

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+

 

[aurelio.ewane]

Bonsoir esaurelien, JHA,

Voyez le fichier joint et ce code :

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]

Bonjour à tous,

Si tu joins un fichier exemple, tu auras certainement des retours.

JHA

Oui Bien sur je vais joindre un fichier

 

[aurelio.ewane]

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.

 

[aurelio.ewane]

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.

 

[JHA]

Bonjour à tous,

Avec ce que je comprends, il y a 3 colonnes masquées en bout de tableau.

JHA

 

[aurelio.ewane]

Bonjour à tous,

Avec ce que je comprends, il y a 3 colonnes masquées en bout de tableau.

JHA

non pas du tout

pas de colonnes masquées

 

[JHA]

Bonjour à tous,

C'est moi qui a créee les 3 colonnes pour déterminer les grandes valeurs de la ligne.

JHA

 

[aurelio.ewane]

Bonjour à tous,

C'est moi qui a créee les 3 colonnes pour déterminer les grandes valeurs de la ligne.

JHA

okeyy je regarde

 

[job75]

Bonjour esaurelien, JHA,

Voyez le fichier joint et cette macro affectée au bouton :

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+

 

[aurelio.ewane]

mercci super ca marche tres cool

 

[job75]

Bonjour esaurelien, JHA, le forum,

Bien entendu on peut se passer du bouton, voyez cette macro dans le code de la feuille :

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+