Chercher Grande valeur pour plusieurs participants

Bonjour et meilleurs vœux à tous,

Tout d’abords, merci à ceux qui consacrent un peu de leurs temps pour apporter des solutions aux membres de notre Forums dont je fais partie.

Voici mon problème :

Je souhaite chercher la plus grande valeur (dans colonne "P" pour chaque participant colonnes "C" sur 3 catégories différentes colonne "Q" :

1ere catégorie ou (1ere Condition) : A4T et ou AK4T, au fait, il s’agit ici de la même catégorie même si le nom de la catégorie change.

2eme catégorie ou (2eme Condition) : B4T et ou BK4T, il s’agit aussi ici également de la même catégorie même si le nom de la catégorie change.

3eme catégorie ou (3eme Condition) : C4T et ou CK4T, il s’agit aussi ici également de la même catégorie même si le nom de la catégorie change.

Pourriez-vous svp me proposer une solution avec vba afin que je puisse l’utiliser pour d’autres cas semblables dans mon projet.

On passe maintenant au traitement et recherche des Grandes valeurs :

Avant de se lancer, deux petites informations :

1 - La liste de participants de la colonne "C" contient le nom des participants identiques et c’est normal, par contre la liste de participants de la colonne "R" ne contient pas de doublons.

2 - Les colonnes "S", "T" et "U" vont recevoir les plus grandes valeurs pour chaque participant venant de la colonne "P" en fonction de la catégorie en question dans la colonne "Q".

On y va ! La 1ere catégorie sur laquelle on va chercher la plus grande valeur pour chaque participant est la catégorie A4T et ou AK4T, on place donc le résultat de cette recherche dans la colonne "S".

Idem pour la catégorie B4T et BK4T à placer dans la colonne "T".

Et enfin la catégorie C4T et CK4T à placer dans la colonne "U".

Vous trouverez en pièce jointe les résultats souhaités pour tous les participants dans les colonnes "S" "T" et "U".

Quant à la colonne "V", elle sert à faire le total par participant pour les 3 catégories.

Je reste à votre disposition pour d’autres informations supplémentaires.

D’avance grand MERCI.

Bonjour à tous,

En attendant vos réponse, j’ai essayé de trouver de mon côté une solution à mon problème sans aucun résultat concluant, j’ai mis le nouveau fichier avec le nouveau code en espérant que quelqu’un d’autre mieux armé que moi trouvera la bonne méthode à mettre en œuvre pour apporter une solution.

Merci pour votre soutien.

Voici le code que j'ai mis en application mais il ne me donne pas le résultat souhaité :

Application.ScreenUpdating = False

derlig1 = Worksheets("Feuil4").Range("R" & Rows.Count).End(xlUp).Row 'dans Colonne R

derlig2 = Worksheets("Feuil4").Range("C" & Rows.Count).End(xlUp).Row 'dans Colonne C

valmax = 0

For i = 2 To derlig1

For j = 2 To derlig2

If Cells(i, "R").Value = Cells(j, "C").Value And Cells(j, "Q").Value = "A4T" Or Cells(j, "Q").Value = "AK4T" Then

If Cells(i, "P").Value > valmax Then

valmax = Cells(j, "P").Value

End If

'Exit For

Cells(i, "S").Value = valmax

Exit For

End If

Next j

Next i

valmax = 0

'i r s t u

For i = 2 To derlig1

For j = 2 To derlig2

If Cells(i, "R").Value = Cells(j, "C").Value And Cells(j, "Q").Value = "B4T" Or Cells(j, "Q").Value = "BK4T" Then

If Cells(i, "P").Value > valmax Then

valmax = Cells(j, "P").Value

End If

Exit For

Cells(i, "T").Value = valmax

' 'Exit For

End If

Next j

Next i

valmax = 0

For i = 2 To derlig1

For j = 2 To derlig2

If Cells(i, "R").Value = Cells(j, "C").Value And Cells(j, "Q").Value = "C4T" Or Cells(j, "Q").Value = "CK4T" Then

If Cells(i, "P").Value > valmax Then

valmax = Cells(j, "P").Value

End If

Cells(i, "U").Value = valmax

'Exit For

End If

Next j

Next i

Application.ScreenUpdating = True

Bonjour,

Il me semble qu'avec ton nombre de message, tu devrais être familiarisé avec l'usage des balises Code, cela ne semble pas être le cas, et je t'engagerais donc à combler cette lacune dans les meilleurs délais.

Ton fichier était livré avec une procédure d'extraction sans doublon de la liste de participants... Tu me pardonneras de l'avoir supprimée purement et simplement ! Elle me gênait pour deux raisons :

  • la première c'est qu'elle n'était pas indentée correctement à mon goût, et l'avoir sous les yeux me perturbait pour taper la mienne !
  • la seconde est que l'extraction sans doublon d'une liste est une spécialité du filtrage avancé, et que utilisé en VBA cela nécessitait une seule ligne de code (et j'ajoute que le filtrage avancé fait partie des rares opérations Excel qui se réalisent plus facilement et plus rapidement en VBA qu'en manuel...), donc cette longue procédure était une perte de temps en rapport aux possibilités existantes, on pouvait fort bien s'en passer.

Enfin, extraire les plus grandes valeurs cherchées par catégories et participants, conduisant nécessairement à un tableau dans lequel chaque participant n'apparaîtrait qu'une fois, ne justifiait pas une telle extraction préalable.

J'ai donc réutilisé ton bouton pour y raccorder la procédure d'extraction des valeurs.

Après ces précisions, voici le code :

Sub PlusGrandesValeurs()
    Dim Tbl(), d As Object, pp, k, pgv, cat, n%, i%
    Set d = CreateObject("Scripting.Dictionary")
    With ActiveSheet
        n = .Cells(.Rows.Count, 3).End(xlUp).Row
        pp = .Range("A2:Q" & n).Value
    End With
    cat = Array("A*4T", "B*4T", "C*4T")
    For i = 1 To UBound(pp)
        k = pp(i, 3)
        For n = 0 To 2
            If pp(i, 17) Like cat(n) Then Exit For
        Next n
        If Not d.exists(k) Then
            d(k) = 0 & ";" & 0 & ";" & 0
        End If
        If n < 3 Then
            ppg = Split(d(k), ";")
            If pp(i, 16) > CInt(ppg(n)) Then ppg(n) = pp(i, 16)
            d(k) = Join(ppg, ";")
        End If
    Next i
    ReDim Tbl(1 To d.Count, 3): n = 0
    For Each k In d.keys
        n = n + 1: ppg = Split(d(k), ";"): Tbl(n, 0) = k
        For i = 0 To 2
            If ppg(i) <> "0" Then Tbl(n, i + 1) = CInt(ppg(i))
        Next i
    Next k
    ActiveSheet.Range("R2").Resize(n, 4).Value = Tbl
End Sub

Quelques explications sur la méthode :

1) On dimensionne la longueur du tableau de données, et on charge ce dernier (de A2 à Q et fin) dans une variable (pp), on obtient ainsi un tableau (d'indice minimal 1) sur lequel on travaillera (hors feuille Excel) plus rapidement.

2) On va utiliser l'outil Dictionnaire : éléments dont la clé sera constitué par le nom du participant, et le contenu par une chaîne de 3 nombres séparés par des ";", chaîne qui nous permettra de consigner les max du participant pour chacune des catégories.

Pour identifier la catégorie, on se prépare un petit tableau (cat) de modèles de la forme "A*4T" [comme on sait l' * pouvant remplacer 1 ou plusieurs caractères ou aucun...], que l'on va donc utiliser avec l'opérateur Like. Notre tableau de catégories comporte 3 élément d'indices 0 à 2, et notre chaîne constituant l'item dico est elle-même splittable pour former un tableau de 3 éléments d'indices 0 à 2. Correspondance assurée donc !

3) On parcourt donc notre tableau pp ligne par ligne : on extrait le nom dans une variable k, on teste la catégorie avec notre petit tableau (on n'en retient dans la variable n que l'indice 0 à 2 qui nous suffira à l'identifier [s'il n'y avait pas correspondance d'une catégorie, n serait égal à 3 en sortie, ce qu'on testera avant affectation]).

On teste ensuite la présence d'un élément dico d(k) déjà existant : s'il n'existe pas, on le prrédéfinit en lui affectant une chaîne "0;0;0" qui permettra d'homgénéiser la suite de la procédure pour tous. On splitte le contenu de l'élément, on compare la valeur pour la catégorie, si la nouvelle est plus grande on la substitue à la précédente...

4) Notre parcours achevé, on monte un tableau de résultats avec autant de lignes que d'éléments dico et 4 colonnes, pour chaque élément on affecte le nom à la première colonne du tableau, et on sépare le contenu en 3 valeurs placées dans leur colonne respective (si valeur >0 car sinon c'est qu'il n'y en avait pas d'enregistrée...)

Et on affecte ce tableau final à son emplacement.

A noter que ce tableau n'est pas trié, mais si on tient à le trier le plus économique est de le trier dans Excel après affectation, un ligne de code à ajouter (j'insiste : une seule ligne ! ).

Cordialement.

Bonjour MFerrand,

Merci d’avoir pris le temps de répondre à ma demande et surtout avec un code qui fonctionne merveilleusement bien, quel Talon !!!!.

Je tiens à titre privé de vous remercier vivement de votre soutien pour ce dernier code et aussi pour les autres codes que vous avez mis à ma disposition pour mes précédentes demandes.

Merci également pour les explications qui accompagnent ce dernier code, c’est tellement précieux.

Vous avez bien fait de retirer le code que j’ai mis pour créer une liste sans doublon, d’autant plus, que ce dernier vous perturbe, je n’y vois aucun inconvénient.

En résumé : Le code réponds à ma demande et me satisfait pleinement, je suis très content.

Vous me dites aussi qu’avec une seule ligne de code, on peut trier le tableau des résultats, de mon côté, je suis incapable de le faire avec une seule ligne de code.

Auriez-vous la gentillesse de me la proposer afin de rendre cette demande totalement résolue.

Merci d’avance.

A vous lire.

Bonjour,

Tu remplaces la dernière ligne (affectation) par ceci qui jumelle affectation et tri en mettant la plage sous bloc With :

    With ActiveSheet.Range("R2").Resize(n, 4)
        .Value = Tbl
        .Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlNo
    End With
End Sub

Cordialement.

Bonjour MFerrand,

Merci pour votre réponse.

Après test de votre code, j’ai remarqué que le tri se fait sur la liste des participants, or le tri souhaité doit se faire comme je l’avais mentionné dans mon premier message (sans être très précis), à savoir sur la colonne "V" :

Pour commencer, dans la cellule V2, on fait la somme des trois cellules suivantes : S2 + T2 + U2.

De même, dans la cellule V3, on fait la somme des trois cellules suivantes : S3 + T3 + U3.

Et ainsi de suite jusqu’au dernier participant.

Lorsque les sommes (Colonne V) des 3 valeurs par participants sont faites, on tri alors le tableau "R2 : V ?" sur la colonne V dans un ordre décroissant.

Merci pour votre soutien.

A vous lire.

Bonsoir MFerrand, Harzer

Une autre façon de procéder : ArrayList et la méthode IndexOf

Option Explicit
Sub test()
Dim a, i As Long, j As Long, AL As Object, dico As Object
    Set AL = CreateObject("System.Collections.ArrayList")
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    a = Sheets("Feuil4").Range("a1").CurrentRegion.Resize(, 17).Value
    For i = 2 To UBound(a, 1)
        a(i, 17) = Left(a(i, 17), 1)
        If Not AL.Contains(a(i, 17)) Then AL.Add a(i, 17)
        If Not dico.exists(a(i, 3)) Then
            Set dico(a(i, 3)) = _
            CreateObject("Scripting.Dictionary")
            dico(a(i, 3)).CompareMode = 1
        End If
        dico(a(i, 3))(a(i, 17)) = Application.Max(dico(a(i, 3))(a(i, 17)), a(i, 16))
    Next
    AL.Sort
    ReDim a(1 To dico.Count + 1, 1 To AL.Count + 2)
    a(1, 1) = "Participants": a(1, 5) = "Totaux"
    For i = 0 To AL.Count - 1
        a(1, i + 2) = AL(i)
    Next
    For i = 0 To dico.Count - 1
        a(i + 2, 1) = dico.keys()(i)
        For j = 0 To dico.items()(i).Count - 1
            a(i + 2, AL.IndexOf(dico.items()(i).keys()(j), 0) + 2) = dico.items()(i).items()(j)
        Next
    Next
    For i = 2 To UBound(a, 1)
        a(i, UBound(a, 2)) = Application.Sum(Application.Index(a, i, Evaluate("row(2:" & UBound(a, 2) - 1 & ")")))
    Next
    'restitution
    With Sheets("Feuil1").Cells(1).Resize(UBound(a, 1), UBound(a, 2))
        .CurrentRegion.ClearContents
        .Value = a: .Parent.Select
    End With
    Set dico = Nothing: Set AL = Nothing
End Sub

klin89

Bonsoir,

J'ai trié tels que tu les avais mentionnés dans le résultat attendu !

Là je n'ai pas très bien compris si tu veux qu'on ajoute le total au résultat, auquel cas cela écrasera les formules que tu avais mis dans la colonne, ou bien si tu veux garder les formules ?

Cordialement.

Bonjour MFerrand et Klin89,

Juste un mot au passage à Klin89, je n’ai pas encore testé votre code, je le ferais après ce message et je vous ferais part de mes commentaires.

Pour répondre à MFerrand, le but du code est de trouver et récupérer le nom du participant le mieux classé et bien entendu récupérer aussi le total de ses 3 meilleurs pointages.

Le fait de trier me permet d’aller chercher le nom et son meilleur résultat dans les cellules R2 et V2.

En résumé, je souhaite ajouter le total au résultat, les formules que j’ai mis étaient là à titre indicatif.

Merci pour votre patience.

Voilà l'ajustement fait !

Tu verras les petites modifs dans le code : ajout d'une colonne au tableau, on y fait la somme des valeurs en le remplissant, affectation inchangée (sauf une colonne en plus), et tri décroissant sur la colonne 5.

Cordialement.

Bonjour Klin89,

Je joins le vrai fichier sur lequel je travaille, ce fichier comporte les (Sous-catégories) suivantes : A – B – C – AK – BK – CK - A4T – B4T - C4T – AK4T – BK4T et CK4T.

Le code ne doit surtout pas prendre en considération les catégories suivantes : A – B – C – AK – BK et CK (voir colonne "Q").

Les catégories qu’on doit traiter sont :

(A4T – AK4T)

(B4T – BK4T)

(C4T – CK4T) : (voir colonne "Q").

La catégorie A4T et AK4T : Il s’agit au fait de la même Catégorie malgré que le non n’est pas identique.

Lorsqu’on cherche la valeur Maximum (Catégories A4T et ou AK4T) pour un participant dans la Feuil4 pour la mettre dans la colonne "B" de la Feuil1, on prend la valeur maximum venant de la catégorie A4T et ou AK4T (Puisqu’il s’agit de la même catégorie).

Idem pour la catégorie B4T et BK4T.

Et c’est aussi la même chose pour la catégorie C4T et CK4T.

Prenons 1 Exemple : On va chercher les valeurs max pour le participant 1 dans les 3 catégories :

Sauf erreur de ma part, voici le résultat attendu :

A4T = 89, AK4T = 92, on va garder 92, qu’on va mettre dans la cellule B2 de la feuil1.

B4T = 99, BK4T = 82, on va garder 99 qu’on va mettre dans la cellule C2 de la feuil1.

C4T = 93, CK4T = "rien", on va garder 93 qu’on va mettre dans la cellule D2 de la feuil1.

Total : 92 + 99 + 93 : La cellule E2 = 284.

Et on fait de même pour tous les participants.

Bien à vous.

7valeurs-max.xlsm (91.87 Ko)

Bonjour MFerrand,

Que dire ! Un seul mot : Magnifique. Le code est Fonctionnel, rapide et répond à toutes mes attentes.

Grand MERCI.

Je ne clôture pas le projet comme résolu, j’attends la réponse de Klin89. Je suis curieux de savoir comment ce dernier pourrait apporter les modifications pour ajuster le code et trouver le résultat souhaité.

Cordiale poignée de mains à vous deux.

Bonjour MFerrand et Klin89,

Je vais marquer le sujet comme résolu grâce à MFerrand, la solution qui m’a été proposé par Klin89 répond en partie à ma demande, si Klin89 souhaite aller au bout afin que sa proposition réponde à mes attentes, je suis partant.

Merci à vous deux.

Amicalement.

Re Harzer

Le code réajusté, j'ai repris la condition émise par MFerrand

Restitution en feuil1

N'oublie pas d'y coller la ligne d'en-têtes en ligne 1

Option Explicit
Sub test()
Dim a, cat, i As Long, j As Long, n As Byte, AL As Object, dico As Object
    Set AL = CreateObject("System.Collections.ArrayList")
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    a = Sheets("Feuil4").Range("a1").CurrentRegion.Value
    cat = Array("A*4T", "B*4T", "C*4T")
    For i = 2 To UBound(a, 1)
        For n = 0 To 2
            If a(i, 17) Like cat(n) Then
                a(i, 17) = Left(a(i, 17), 1)
                If Not AL.Contains(a(i, 17)) Then AL.Add a(i, 17)
                If Not dico.exists(a(i, 3)) Then
                    Set dico(a(i, 3)) = _
                    CreateObject("Scripting.Dictionary")
                    dico(a(i, 3)).CompareMode = 1
                End If
                dico(a(i, 3))(a(i, 17)) = Application.Max(dico(a(i, 3))(a(i, 17)), a(i, 16))
                Exit For
            End If
        Next
    Next
    AL.Sort
    ReDim a(1 To dico.Count, 1 To AL.Count + 2)
    For i = 0 To dico.Count - 1
        a(i + 1, 1) = dico.keys()(i)
        For j = 0 To dico.items()(i).Count - 1
            a(i + 1, AL.IndexOf(dico.items()(i).keys()(j), 0) + 2) = dico.items()(i).items()(j)
        Next
    Next
    For i = 1 To UBound(a, 1)
        a(i, UBound(a, 2)) = Application.Sum(Application.Index(a, i, Evaluate("row(2:" & UBound(a, 2) - 1 & ")")))
    Next
    'restitution
    With Sheets("Feuil1").Cells(1).CurrentRegion
        With .Offset(1)
            .ClearContents
            With .Resize(UBound(a, 1), UBound(a, 2))
                .Value = a
                .Sort key1:=.Cells(1, 5), order1:=xlDescending, Header:=xlNo
            End With
            .Parent.Select
        End With
    End With
    Set dico = Nothing: Set AL = Nothing
End Sub

klin89

Bonjour Klin89,

Merci d'avoir accepté de continuer l’aventure jusqu'à la résolution finale du problème.

J’ai testé votre code, il fonctionne aussi bien que celui de MFerrand. Bravo à tous les deux.

Il manque toutefois un petit détail à adapter, il concerne la restitution des valeurs trouvées.

C’est pour cela que je me permets de vous demander se modifier le code de telle manière au lieu de restituer les résultats trouvées sur une autre Feuille (Feuil1) à partir de la cellule "A2", de le restituer sur la même feuille (Feuil4) à partir de la cellule "R2".

D’avance Merci.

A vous lire.

Bonjour Klin89,

Ne prends plus prendre en considération ma demande, j'ai trouvé la manière pour restituer les données dans la feuil4 en R2 en changeant :

la 'Feuil1' par 'Feuil4'

Et en changeant la ligne suivante :

With .Offset(1)

Par :

With .Offset(1, 17)

Merci beaucoup.

Amicalement.

Bien à vous.

Rechercher des sujets similaires à "chercher grande valeur participants"