XL 2016 formule de 1°place a la 10°

Guismo33 · 16 Mars 2017

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

Dugenou · 16 Mars 2017

Bonjour,
Tu peux utiliser la fonction RANG.
Mais pour en dire plus il faudrait un fichier exemple

thebenoit59 · 16 Mars 2017

Bonjour Guismo.

Un fichier est plus que nécessaire pour pouvoir t'aider.

Edit: Bonjour Dugenou.

CISCO · 16 Mars 2017

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

job75 · 16 Mars 2017

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+

job75 · 16 Mars 2017

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+

job75 · 17 Mars 2017

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.

job75 · 17 Mars 2017

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+

Guismo33 · 22 Mars 2017

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+

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

Guismo33 · 22 Mars 2017

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+

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

Guismo33 · 22 Mars 2017

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

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

XL 2016 formule de 1°place a la 10°

Guismo33

XLDnaute Occasionnel

Dugenou

XLDnaute Barbatruc

thebenoit59

XLDnaute Accro

CISCO

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Guismo33

XLDnaute Occasionnel

Guismo33

XLDnaute Occasionnel

Guismo33

XLDnaute Occasionnel

Discussions similaires

XL 2016 formule de 1°place a la 10°

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency