XL 2016 n plus grand nombres dun tableau

A

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
 
Trier par date Trier par votes
job75

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
Vote positif 0 Vote négatif
A

aurelio.ewane

XLDnaute Occasionnel
job75 à dit:
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+
Cliquez pour agrandir...
Bonjour
je vais essayer de joindre un fichier
merci pour vos retour
 
Vote positif 0 Vote négatif
A

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
Vote positif 0 Vote négatif
A

aurelio.ewane

XLDnaute Occasionnel
JHA à dit:
Bonjour à tous,

Peut-être comme cela.

JHA
Cliquez pour agrandir...
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
Vote positif 0 Vote négatif
job75

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:
Vote positif 0 Vote négatif
job75

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
Vote positif 0 Vote négatif

Discussions similaires

B
  • Question
XL 2016 Compiler les données de différente feuille
2
Réponses
15
Affichages
625
Bebzinda
B
B
  • Résolu(e)
XL 2021 Le grand écart
Réponses
4
Affichages
220
bobafric
B
B
  • Résolu(e)
XL 2021 Grand écart suite
Réponses
10
Affichages
191
mapomme
mapomme
O
  • Question
Microsoft 365 Cours crypto API Coinmarketcap
Réponses
2
Affichages
331
Staple1600
Staple1600
E
  • Résolu(e)
Microsoft 365 Grand Livre données exploitables
2
Réponses
28
Affichages
1 K
eric72
E
M
  • Résolu(e)
XL 2010 Nature du type de prix de la facture
Réponses
3
Affichages
247
Mody200
M
B
  • Question
XL 2019 trouver le plus grand numéro
Réponses
11
Affichages
241
Blafi
B
E
  • Question
XL 2019 Fichier de suivi d'échanges de données
Réponses
0
Affichages
101
Ericduke
E
C
  • Question
Autres RESOLU synthèse d'un tableau
Réponses
9
Affichages
353
chapipi
C
R
  • Question
XL 2010 Problème avec liste déroulante sur des cellule déjà rempli
Réponses
6
Affichages
319
rider
R

Membres actuellement en ligne

2 membres et 50 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 628
Messages
2 111 337
Membres
111 105
dernier inscrit
Joffrette