Classement rangs et recuperation de donnees automatiques

[moustic54]

Bonjour à tous,

Le titre du message n'est pas explicite.
Je voudrais pouvoir à partir d'un onglet base, récupérer automatiquement les données sur un nouvel onglet,
- selon les 9 titres se trouvant dans l'onglet base
- les n° et départements des 13 premiers classés selon leurs rangs (du 1er au 13eme rang inclus)

Je joins un fichier pour être plus clair.

Merci d'avance à toux ceux et celles qui pourront m'aider.

 

[Dranreb]

Re : Classement rangs et recuperation de donnees automatiques

Bonjour.
Dans le module "Feuil2 (BILAN)":

Option Explicit

Private Sub Worksheet_Activate()
Dim TDéptmt() As Variant, LMax As Long, TLgn() As Long, M As Long, _
   TRng() As Variant, L As Long, TRésu() As Variant, N As Long
TDéptmt = Feuil1.Range("B5:C" & Feuil1.[B65536].End(xlUp).Row).Value
LMax = UBound(TDéptmt)
ReDim TLgn(1 To LMax) As Long
For M = 1 To 9
   If M = 9 Then TRng = Feuil1.[AP5].Resize(LMax).Value _
            Else TRng = Feuil1.[H5].Offset(, M * 4).Resize(LMax).Value
   For L = 1 To LMax: TLgn(TRng(L, 1)) = L: Next L
   ReDim TRésu(1 To 13, 1 To 2)
   For N = 1 To 13: L = TLgn(N): TRésu(N, 1) = TDéptmt(L, 1): TRésu(N, 2) = TDéptmt(L, 2): Next N
   Me.Cells(((M - 1) \ 3) * 22 + 7, ((M - 1) Mod 3) * 4 + 1).Resize(13, 2).Value = TRésu
   Next M
End Sub

Cordialement.

 

[moustic54]

Re : Classement rangs et recuperation de donnees automatiques

Bonjour Dranreb,

Merci pour votre aide.
J'aurai quelques questions sur le code qui je ne comprends pas étant vraiment néophyte

Cette ligne par exemple
For N = 1 To 13: L = TLgn(N): TRésu(N, 1) = TDéptmt(L, 1): TRésu(N, 2) = TDéptmt(L, 2): Next N
Me.Cells(((M - 1) \ 3) * 22 + 7, ((M - 1) Mod 3) * 4 + 1).Resize(13, 2).Value = TRésu

- Pourquoi ce calcul ?

- Peut on récupérer également le rang dans l'onglet bilan?

- Que va t il arriver s'il y a des rangs identiques (ex de 3 départements ayant le même classement dans une même colonne ? Les doublons étant autorisés.

 

[mapomme]

Re : Classement rangs et recuperation de donnees automatiques

Bonjour moustic54, Dranreb

Un essai avec formule matricielle.

Pour les ex-aequo, j'ai laissé 5 lignes en dessous de chaque tableau. Une Mise en Forme Conditionnelle (MFC) masque le bas de chaque tableau si le rang dépasse 13 (voir tableau 6 et 9). En toute logique, chaque tableau devrait comporter 65 lignes (cas où chaque département serait 1ier par exemple)

Formule matricielle: Elle doit être validée par la combinaison des touches Ctrl+Maj+Entrée au lieu de la seule touche Entrée comme une formule classique.
Si la validation matricielle est correcte, alors Excel entoure la formule d'accolades {=.......}.
Chaque fois que cette formule sera modifiée, la validation devra se faire par Ctrl+Maj+Entrée. Les accolades apparaissent à la validation et ne doivent pas être saisies au clavier.

 

[moustic54]

Re : Classement rangs et recuperation de donnees automatiques

Bonjour mapomme,

Vous avez raison sur le nombre de lignes entre chaque tableau.

J'avais opté ipour le principe de formules, moins jolies que les votres, mais le fichier devant être uilisé par moult personnes, je pensais que le faire en macro était plus sécurisant.

Comme je l'écrivais à Dranreb, je suis néophyte et les codes vba utilisés sont proches de formules magiques d'où mes questions.
J'espère qu'il pourra m'en expliquer quelques unes.

Merci à tous deux pour votre aide

 

[Dranreb]

Re : Classement rangs et recuperation de donnees automatiques

For N = 1 To 13: L = TLgn(N): TRésu(N, 1) = TDéptmt(L, 1): TRésu(N, 2) = TDéptmt(L, 2): Next N

Remplit la table qui sera reversée dans chaque tableau

Me.Cells(((M - 1) \ 3) * 22 + 7, ((M - 1) Mod 3) * 4 + 1).Resize(13, 2).Value = TRésu

Reverse la table dans le tableau. C'est toujours plus rapide que de remplir cellule par cellule. Ici: 26 fois plus rapide. L'accès à 26 cellules d'un coup est en effet aussi rapide que l'accès à une seule.
J'ai fait confiance aux rangs, je n'ai pas géré d'éventuels doublons parmi eux.
À +

 

[moustic54]

Re : Classement rangs et recuperation de donnees automatiques

Bonjour Dranreb,

Merci pour vos explications.
Mais comment peut on à présent adapter la macro pour une prise en compte des doublons ?
Tout en reprenant les rangs en colonnes C de l'onglet Bilan ? La macro ne reprenant que les colones A et B.
C'est ce que je souhaiterai obtenir.

D'avance merci

 

[Dranreb]

Re : Classement rangs et recuperation de donnees automatiques

Bonjour.
Modifiez la procédure comme suit:

Option Explicit

Private Sub Worksheet_Activate()
Dim TDéptmt() As Variant, LMax As Long, M As Long, X As New TableIndex, _
   TRng() As Variant, L As Long, TRésu() As Variant, N As Long
TDéptmt = Feuil1.Range("B5:C" & Feuil1.[B65536].End(xlUp).Row).Value
LMax = UBound(TDéptmt)
ReDim TLgn(1 To LMax) As Long
For M = 1 To 9
   If M = 9 Then TRng = Feuil1.[AO5].Resize(LMax, 2).Value _
            Else TRng = Feuil1.[K5].Offset(, (M - 1) * 4).Resize(LMax, 2).Value
   X.Init 1, LMax
   While X.Actif
      X.BInfA = TRng(X.B, 1) < TRng(X.A, 1)
      Wend
   ReDim TRésu(1 To 13, 1 To 3)
   X.Parcourir
   For N = 1 To 13: L = X.Suivant
      TRésu(N, 1) = TDéptmt(L, 1)
      TRésu(N, 2) = TDéptmt(L, 2)
      TRésu(N, 3) = TRng(L, 2): Next N
   Me.Cells(((M - 1) \ 3) * 22 + 7, ((M - 1) Mod 3) * 4 + 1).Resize(13, 3).Value = TRésu
   Next M
End Sub

et importez le module TableIndex seulement de ce ZIP

Remarque: les département sont restitués par ordre croissant des valeurs en colonnes titrées "A/B" et "Total Rang", mais les chiffres restitué sont ceux des colonnes "Rang" à leur droite. S'il faut tenir compte des 3ième paramètres des formules =RANG pour restituer certain tableaux en ordre décroissant c'est possible. Dans ce cas:

Option Explicit

Private Sub Worksheet_Activate()
Dim TDéptmt() As Variant, LMax As Long, M As Long, X As New TableIndex, Croiss As Boolean, _
   Plage As Range, TRng() As Variant, L As Long, TRésu() As Variant, N As Long
TDéptmt = Feuil1.Range("B5:C" & Feuil1.[B65536].End(xlUp).Row).Value
LMax = UBound(TDéptmt)
ReDim TLgn(1 To LMax) As Long
For M = 1 To 9
   If M = 9 Then Set Plage = Feuil1.[AO5] _
            Else Set Plage = Feuil1.[K5].Offset(, (M - 1) * 4)
   TRng = Plage.Resize(LMax, 2).Value
   Croiss = Split(Plage.Offset(, 1).Formula, ",")(2) = "1)"
   X.Init 1, LMax
   While X.Actif
      X.BInfA = Croiss Eqv TRng(X.B, 1) < TRng(X.A, 1)
      Wend
   ReDim TRésu(1 To 13, 1 To 3)
   X.Parcourir
   For N = 1 To 13: L = X.Suivant
      TRésu(N, 1) = TDéptmt(L, 1)
      TRésu(N, 2) = TDéptmt(L, 2)
      TRésu(N, 3) = TRng(L, 2): Next N
   Me.Cells(((M - 1) \ 3) * 22 + 7, ((M - 1) Mod 3) * 4 + 1).Resize(13, 3).Value = TRésu
   Next M
End Sub

Mais vous auriez quand même pu prévenir alors ! Il y a partout écrit "RANG CROISSANT", et j'ai été surpris, au premier test, de trouver certaines séries décroissantes commençant à 65 !
À +

 

[moustic54]

Re : Classement rangs et recuperation de donnees automatiques

Bonsoir Dranreb

Les rangs de la Base se font selon le titre c'est-à-dire parfois croissant, parfois décroissant mais l'onglet Bilan sera toujours par classement de 1 à 13.
J'essaie de comprendre votre macro plutôt que de recopier bêtement vos formules. Mais je suis néophyte et ce qui peut vous paraitre logique et simple ne l'est pas pour moi.

Mes questions vont donc vous sembler stupides mais :

- à quoi correspond dans votre macro
Me.Cells(((M - 1) \ 3) * 22 + 7, ((M - 1) Mod 3) * 4 + 1).Resize(13, 3).Value = TRésu

Pourquoi * 22 + 7 ?

- Si mon classeur comprend plusieurs onglets, ne doit on pas nommer les feuilles dans la macro pour éviter les confusions car je ne vois aucun nom (sauf les références à la feuille 1) dans votre macro.

- Dans l'hypothese où la feuille de calcul (BASE) comprendrait bien plus de colonnes où dois je inscrire la derniere colonne Dans le fichier la derniere colone est AP qu'en serait il s'il s'agissait de AS ? Là aussi je n'ai rien vu dans la macro qui limite la base
Idem si la feuille contient bien plus de lignes. Mais je ne m'y connais pas assez pour tout décortiquer pas à pas.

 

[Dranreb]

Re : Classement rangs et recuperation de donnees automatiques

Pourquoi * 22 + 7 ?

Parce que les 9 tableaux sont disposés, par groupes de 3, toutes les 22 lignes à partir de la 7

- Si mon classeur comprend plusieurs onglets, ne doit on pas nommer les feuilles dans la macro pour éviter les confusions car je ne vois aucun nom (sauf les références à la feuille 1) dans votre macro.

Il y a aussi Me qui désigne la feuille à laquelle le code est attaché.

- Dans l'hypothese où la feuille de calcul (BASE) comprendrait bien plus de colonnes où dois je inscrire la derniere colonne Dans le fichier la derniere colone est AP qu'en serait il s'il s'agissait de AS ?

3 colonnes de plus ? pas 4 ? curieux ! Actuelement c'est le For M = 1 To 9 qui limite, et Feuil1.[AO5] pour les deux dernières colonnes qui ne sont pas, contrairement aux autres, toutes les 4.
Cordialement.

 

[moustic54]

Re : Classement rangs et recuperation de donnees automatiques

Bonsoir Dranreb

Si mon classeur comprend plusieurs onglets, ne doit on pas nommer les feuilles dans la macro pour éviter les confusions car je ne vois aucun nom (sauf les références à la feuille 1) dans votre macro.

Il y a aussi Me qui désigne la feuille à laquelle le code est attaché.

Je me suis mal exprimé, je voulais dire si mon classeur contient par exemple : 3 onglets minimum
le 1er = Bilan qui correspond à ma feuille "réceptrice"
le 2eme = Base 1
le 3eme = Base 2

Dans mon fichier joint, le classeur ne contenait que 2 onglets : bilan et base. Et j'ai bien compris que le Me était quoiqu'il arrive, lié à la feuille dans laquelle la macro était inscrite (ici bilan)
Mais comment lui faire comprendre (dans le cas de 2 onglets bases 1 et 2) que les données sont à récupérer en base 1 et non en base 2 puisqu'il n'y est fait aucune réf. dans la macro au nom de la feuille sur laquelle sont inscrites les données ?

Suis je plus clair dans ma question ?

Cordialement

 

[Dranreb]

Re : Classement rangs et recuperation de donnees automatiques

Pourquoi se référer aux noms Excel des feuilles, que l'utilisateur peut changer à sa guise ?
J'utilise toujours leurs noms VBA. Cela évite une recherche dans la collection Worksheets puisqu'ils représentent directement des objets Worksheet connus du projet VBA.

Mais si vous aviez plusieurs feuilles "Base n", souhaiteriez vous que le calcul se base systématiquement sur la dernière feuille activée ?

 

[moustic54]

Re : Classement rangs et recuperation de donnees automatiques

Bonsoir Dranreb

Mais si vous aviez plusieurs feuilles "Base n", souhaiteriez vous que le calcul se base systématiquement sur la dernière feuille activée ?

Dans mon fichier original, j'ai en effet 4 onglets base + une douzaine d'onglets de données mais ce que je voudrais surtout faire à échéance c'est pourvoir faire plusieurs onglets Bilan comme autant d'hypotheses envisagées selon l'onglet base 1 (rangs croissants et décroissants) et base 2 (rangs croissants uniquement).
C'est aussi la raison pour laquelle j'essaye de comprendre vos macro, le classeur original n'étant pas figé.
Mais peut-être que cela est impossible à réaliser sous forme de macro.

 

[Dranreb]

Re : Classement rangs et recuperation de donnees automatiques

Mais peut-être que cela est impossible à réaliser sous forme de macro.

Il me semblait pourtant qu'on avait bien avancé !
Mais on ne peut pas faire confiance à la fonction RANG à cause des doublons de rangs égaux. Je suis étonné de ne pas retrouver mon module de classe TableIndex qui réglait le problème.

Vous auriez peut être intérêt à modifier les noms VBA des feuilles pour vous y retrouver plus facilement. C'est la 1ère propriété dans la fenêtre de propriétés ("(Name)" indiqué comme ça, entre parenthèses). Par exemple renommer Feuil3 en FBas1 et Feuil1 en FBas2 (attention pas d'espace: ça doit obéir aux mêmes règles que les noms de variables).

Remarquez: si ça vous arrange mieux vous pourriez plutôt écrire une fonction dans un module ordinaire cette fois:

Option Explicit

Function Bilan(ByVal Critère As Range, ByVal Croiss As Boolean, ByVal Déptmt As Range) As Variant()
Dim TDéptmt() As Variant, TCrit() As Variant, LMax As Long, X As New TableIndex, _
   N As Long, L As Long, TRésu(1 To 13, 1 To 3) As Variant
TDéptmt = Déptmt.Value
TCrit = Critère.Value
LMax = UBound(TDéptmt)
X.Init 1, LMax
While X.Actif
   X.BInfA = Croiss Eqv TCrit(X.B, 1) < TCrit(X.A, 1)
   Wend
X.Parcourir
For N = 1 To 13: L = X.Suivant
   TRésu(N, 1) = TDéptmt(L, 1)
   TRésu(N, 2) = TDéptmt(L, 2)
   TRésu(N, 3) = N
   Next N
Bilan = TRésu
End Function

Elle est notamment utilisable comme fonction matricielle personnalisée:
En A7:C19 de "BILAN 1A":

=Bilan('BASE 1'!$K$5:$K$73;FAUX;'BASE 1'!$B$5:$C$73)

validé en matriciel (combinaison de touches Ctrl+Maj+Entrée)
À +

 

[moustic54]

Re : Classement rangs et recuperation de donnees automatiques

J

Elle est notamment utilisable comme fonction matricielle personnalisée:
En A7:C19 de "BILAN 1A":

J'ai essayé d'utiliser la fomule matricielle mais le rang apparait toujours à 60

En effet nous avions bien avancé gràce à vous mais je suis néophyte et vous voyez que dans les onglets bilan les tableaux ne sont pas disposés de la même façon et pour compliquer le tout, ils ne sont pas dans l'ordre.
J'ai des difficultés à adapter vos macros selon les cas.