XL 2016 formule de 1°place a la 10°

G

Guismo33

XLDnaute Occasionnel
Bonjour a tous,

J'ai 31 feuils et dans ces feuils 4 tableaux identiques et au même endroit .
les feuils se nome feuil1 à feuil31 et en K3:R3 des nombres .
Je recherche une formule qui me dit qui est 1°au 10° sur K3 sur toutes les feuils

en vous remerciant



bien à vous
 
Trier par date Trier par votes
CISCO

CISCO

XLDnaute Barbatruc
Bonjour à tous, bonjour Dugenou et Thebenoit59.

Une possibilité en pièce jointe sur la feuille 4. Pour avoir mieux, un petit fichier en pièce jointe serait le bienvenu...

@ plus
 

Pièces jointes

  • exemple rang.xlsx
    9.7 KB · Affichages: 37
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonsoir Guismo33, Dugenou, thebenoit59, CISCO,

Voyez dans le fichier joint cette fonction VBA et la macro Quick sort :
Code: 
Function Classement31Feuilles(ref As String)
Application.Volatile
Dim i As Byte, a(1 To 31), b(1 To 31), c(1 To 31, 1 To 2)
For i = 1 To 31
  a(i) = Sheets(i + 1).Range(ref)
  b(i) = Sheets(i + 1).Name
Next
tri a, b, 1, 31
For i = 1 To 31
  c(i, 1) = b(i)
  c(i, 2) = a(i)
Next
Classement31Feuilles = c 'tableau 31 x 2
End Function

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
La fonction est utilisée dans le tableau de la feuille "Récap".

Les noms des feuilles sont sans importance mais elles doivent être placées à la suite de la feuille "Récap".

A+
 

Pièces jointes

  • Classement de 31 feuilles(1).xlsm
    54 KB · Affichages: 25
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re,

Le calcul est beaucoup plus rapide avec une validation matricielle sur la plage C5: D14.

Fichier (2).

Edit : chez moi sur Win 10 - Excel 2013 :

- recalcul du fichier (1) => 14,5 millièmes de seconde

- recalcul du fichier (2) => 0,9 millième de seconde.

A+
 

Pièces jointes

  • Classement de 31 feuilles(2).xlsm
    54.5 KB · Affichages: 30
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour le forum,

On peut paramétrer le nombre de feuilles prises en compte :
Code: 
Function ClassementFeuilles(ref As String, N As Byte)
Application.Volatile
If ref = "" Or N = 0 Then ClassementFeuilles = "": Exit Function
Dim i As Byte
ReDim a(1 To N): ReDim b(1 To N): ReDim c(1 To N, 1 To 2)
For i = 1 To N
  a(i) = Sheets(i + 1).Range(ref)
  b(i) = Sheets(i + 1).Name
Next
tri a, b, 1, N
For i = 1 To N
  c(i, 1) = b(i)
  c(i, 2) = a(i)
Next
If N > 9 Then ClassementFeuilles = c: Exit Function 'tableau N x 2
Dim d(1 To 10, 1 To 2)
For i = 1 To 10
  If i > N Then d(i, 1) = "": d(i, 2) = "" _
    Else d(i, 1) = c(i, 1): d(i, 2) = c(i, 2)
Next
ClassementFeuilles = d 'tableau 10 x 2
End Function
Bonne journée.
 

Pièces jointes

  • Classement de N feuilles(1).xlsm
    55.5 KB · Affichages: 24
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re,

Une autre solution est de faire un classement de feuille à feuille :
Code: 
Function ClassementFeuilles(ref$, deb$, fin$)
Application.Volatile
If ref = "" Or deb & fin = "" Then ClassementFeuilles = "": Exit Function
Dim i%, j%, n As Byte
If deb = "" Then deb = fin
If fin = "" Then fin = deb
i = Application.Match(deb, [Liste], 0)
j = Application.Match(fin, [Liste], 0)
n = Abs(i - j) + 1
ReDim a(1 To n): ReDim b(1 To n): ReDim c(1 To n, 1 To 2)
j = IIf(i < j, i, j)
For i = 1 To n
  a(i) = Sheets(i + j).Range(ref)
  b(i) = Sheets(i + j).Name
Next
tri a, b, 1, n
For i = 1 To n
  c(i, 1) = b(i)
  c(i, 2) = a(i)
Next
If n > 9 Then ClassementFeuilles = c: Exit Function 'tableau N x 2
Dim d(1 To 10, 1 To 2)
For i = 1 To 10
  If i > n Then d(i, 1) = "": d(i, 2) = "" _
    Else d(i, 1) = c(i, 1): d(i, 2) = c(i, 2)
Next
ClassementFeuilles = d 'tableau 10 x 2
End Function
La liste Liste des noms des feuilles est établie par cette macro dans le code de la feuille "Récap" :
Code: 
Private Sub Worksheet_Calculate()
'liste des noms des 31 feuilles en colonne A
Dim i As Byte, a(1 To 31, 1 To 1)
For i = 1 To 31
  a(i, 1) = Sheets(i + 1).Name
Next
Application.EnableEvents = False
[A2:A32] = a
Application.EnableEvents = True
End Sub
C'est nécessaire en cas de modification des noms des feuilles ou de leurs positions.

A+
 

Pièces jointes

  • Classement de feuille à feuille(1).xlsm
    57.6 KB · Affichages: 31
Vote positif 0 Vote négatif
G

Guismo33

XLDnaute Occasionnel
job75 à dit:
Re,

Une autre solution est de faire un classement de feuille à feuille :
Code: 
Function ClassementFeuilles(ref$, deb$, fin$)
Application.Volatile
If ref = "" Or deb & fin = "" Then ClassementFeuilles = "": Exit Function
Dim i%, j%, n As Byte
If deb = "" Then deb = fin
If fin = "" Then fin = deb
i = Application.Match(deb, [Liste], 0)
j = Application.Match(fin, [Liste], 0)
n = Abs(i - j) + 1
ReDim a(1 To n): ReDim b(1 To n): ReDim c(1 To n, 1 To 2)
j = IIf(i < j, i, j)
For i = 1 To n
  a(i) = Sheets(i + j).Range(ref)
  b(i) = Sheets(i + j).Name
Next
tri a, b, 1, n
For i = 1 To n
  c(i, 1) = b(i)
  c(i, 2) = a(i)
Next
If n > 9 Then ClassementFeuilles = c: Exit Function 'tableau N x 2
Dim d(1 To 10, 1 To 2)
For i = 1 To 10
  If i > n Then d(i, 1) = "": d(i, 2) = "" _
    Else d(i, 1) = c(i, 1): d(i, 2) = c(i, 2)
Next
ClassementFeuilles = d 'tableau 10 x 2
End Function
La liste Liste des noms des feuilles est établie par cette macro dans le code de la feuille "Récap" :
Code: 
Private Sub Worksheet_Calculate()
'liste des noms des 31 feuilles en colonne A
Dim i As Byte, a(1 To 31, 1 To 1)
For i = 1 To 31
  a(i, 1) = Sheets(i + 1).Name
Next
Application.EnableEvents = False
[A2:A32] = a
Application.EnableEvents = True
End Sub
C'est nécessaire en cas de modification des noms des feuilles ou de leurs positions.

A+
Cliquez pour agrandir...
Bonjour a tous ,

Merci a tous pour votre travail, je pensais ne pas être claire mais a voir le résultat, je me suis fait comprendre.

Comme je dit souvent heureusement que vous êtes la pour les novices.

encore un grand merci


Bien à vous
 
Vote positif 0 Vote négatif
G

Guismo33

XLDnaute Occasionnel
job75 à dit:
Re,

Une autre solution est de faire un classement de feuille à feuille :
Code: 
Function ClassementFeuilles(ref$, deb$, fin$)
Application.Volatile
If ref = "" Or deb & fin = "" Then ClassementFeuilles = "": Exit Function
Dim i%, j%, n As Byte
If deb = "" Then deb = fin
If fin = "" Then fin = deb
i = Application.Match(deb, [Liste], 0)
j = Application.Match(fin, [Liste], 0)
n = Abs(i - j) + 1
ReDim a(1 To n): ReDim b(1 To n): ReDim c(1 To n, 1 To 2)
j = IIf(i < j, i, j)
For i = 1 To n
  a(i) = Sheets(i + j).Range(ref)
  b(i) = Sheets(i + j).Name
Next
tri a, b, 1, n
For i = 1 To n
  c(i, 1) = b(i)
  c(i, 2) = a(i)
Next
If n > 9 Then ClassementFeuilles = c: Exit Function 'tableau N x 2
Dim d(1 To 10, 1 To 2)
For i = 1 To 10
  If i > n Then d(i, 1) = "": d(i, 2) = "" _
    Else d(i, 1) = c(i, 1): d(i, 2) = c(i, 2)
Next
ClassementFeuilles = d 'tableau 10 x 2
End Function
La liste Liste des noms des feuilles est établie par cette macro dans le code de la feuille "Récap" :
Code: 
Private Sub Worksheet_Calculate()
'liste des noms des 31 feuilles en colonne A
Dim i As Byte, a(1 To 31, 1 To 1)
For i = 1 To 31
  a(i, 1) = Sheets(i + 1).Name
Next
Application.EnableEvents = False
[A2:A32] = a
Application.EnableEvents = True
End Sub
C'est nécessaire en cas de modification des noms des feuilles ou de leurs positions.

A+
Cliquez pour agrandir...
Bonjour a tous ,

Merci a tous pour votre travail, je pensais ne pas être claire mais a voir le résultat, je me suis fait comprendre.

Comme je dit souvent heureusement que vous êtes la pour les novices.

encore un grand merci


Bien à vous
 
Vote positif 0 Vote négatif
G

Guismo33

XLDnaute Occasionnel
CISCO à dit:
Bonjour à tous, bonjour Dugenou et Thebenoit59.

Une possibilité en pièce jointe sur la feuille 4. Pour avoir mieux, un petit fichier en pièce jointe serait le bienvenu...

@ plus
Cliquez pour agrandir...
Bonjour a tous ,

Merci a tous pour votre travail, je pensais ne pas être claire mais a voir le résultat, je me suis fait comprendre.

Comme je dit souvent heureusement que vous êtes la pour les novices.

encore un grand merci


Bien à vous
 
Vote positif 0 Vote négatif

Discussions similaires

S
  • Question
XL 2016 répartition équitable
Réponses
6
Affichages
378
Seddiki_adz
S
J
  • Résolu(e)
XL 2013 Formule si avec conditions
Réponses
13
Affichages
291
nat54
nat54
F
  • Question
Microsoft 365 Mettre une condition sur un Top 10 dans un graphique croisé dynamique
Réponses
1
Affichages
426
chris
chris
M
  • Question
Microsoft 365 Formule avec OU ?
Réponses
5
Affichages
225
moanin
M
halecs93
  • Résolu(e)
XL 2016 Propagation de données
2
Réponses
28
Affichages
741
halecs93
halecs93
Usine à gaz
  • Question
XL 2021 code que je n'arrive pas à faite fonctionner avec Range("ActiveCell.Offset(0, 0).Resize(10, 1)")
2 3 4
Réponses
55
Affichages
1 K
Staple1600
Staple1600
F
  • Résolu(e)
XL 2019 Power Query - Demande d'optimisation de l'exemple
Réponses
7
Affichages
456
Flx1er
F
T
  • Question
XL 2019 RECHERCHEV la source peut ne comporter qu'une partie de la plage
Réponses
5
Affichages
317
sylvanu
sylvanu
S
  • Question
XL 2021 Compter le nombre de fois qu'une tranche d'heures apparait dans une plage de cellules
Réponses
3
Affichages
357
Sanni
S
M
  • Résolu(e)
Microsoft 365 Formule année bissextile
2 3
Réponses
32
Affichages
1 K
Marvin57
M

Membres actuellement en ligne

Aucun membre en ligne actuellement.
1 membres et 34 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
312 196
Messages
2 086 100
Membres
103 116
dernier inscrit
kutobi87