Sélectionner des cases selon des critères

Bonjour !

Imaginons que j'ai :

J'aimerais bien à la fin avoir le tableau suivant :

En gros, j'aimerais bien relever et trier tous les noms (et les notes à droite) qui commencent par Pier, et à la suite, ceux qui commencent par Aman.

Le souci, c'est que je n'ai aucune idée de comment faire. J'avais pensé à VLOOKUP mais pas sûr que ça fonctionne car j'ai peur que ça s'arrête à la première case qui commence par "Pier" par exemple.

Merci d'avance !

PS : J'ai Excel en anglais si ça change quelque chose.

Salut Kwns,

ma solution en VBA.
Tu as toute une tripotée de réglages possibles :
- la BDD de base en [A:A] peut être triée Ascendante ou Descendante en double-cliquant à la volée en [A1] ;
- idem en [F:F] en gardant en tête que ce tri en [F:F] sera, en fonction d'un réglage en [G:H] l'ordre de recherche ;
- en [G:H], tu choisis les références de [F:F] qui serviront au tri. Tu peux choisir de ne te servir que de la colonne [G:G] soit de la colonne [H:H].

En [G:G] seulement
- un clic sur une cellule la marque d'un "V" ou l'annule ;
- le tri se fera dans l'ordre logique, selon le tri appliqué, de la liste en [F:F] ;
- un clic DROIT en [G1] allume ou éteint tous les "V".

En [H:H] - "Ordre"
- ici aussi, tu choisis les références qui serviront au tri mais, de plus, tu peux déterminer leur ordre de passage lors du tri ;
- un clic sur une cellule incrémente un compteur ;
- un clic DROIT en [H1] efface ces compteurs.

Pour lancer le tri, double-clic en [G1] et affichage des résultats en [K:L]

If Not Intersect(Target, [G1]) Is Nothing And [A2] <> "" And [F2] <> "" Then
    If WorksheetFunction.CountA(Range("G2:G" & iRowF)) > 0 Then
        Columns("K:L").ClearContents
        tTab = Range("A2:B" & iRowA).Value
        If [A3] <> "" Then Call TriA(IIf([F1].Font.Italic = False, 0, 1))
        iFlag = IIf([H1].Font.Bold = True, 1, 0)
        '
        On Error Resume Next
        For x = 1 To WorksheetFunction.CountA(IIf(iFlag = 0, Range("G2:G" & iRowF), Range("H2:H" & iRowF)))
            iRow = IIf(iFlag = 0, _
                Range("G1:G" & iRowF).Find(what:="P", lookat:=xlWhole, LookIn:=xlValues), _
                Range("H1:H" & iRowF).Find(what:=WorksheetFunction.Min(Range("H2:H" & iRowF)), lookat:=xlWhole, LookIn:=xlValues)).Row
            Range(Chr(71 + iFlag) & iRow).Value = ""
            sData = Range("F" & iRow).Value
            For y = 1 To UBound(tTab, 1)
                If Left(tTab(y, 1), Len(sData)) = sData Then _
                    iIdx = iIdx + 1: _
                    ReDim Preserve tOut(2, iIdx): _
                    tOut(0, iIdx - 1) = tTab(y, 1): _
                    tOut(1, iIdx - 1) = tTab(y, 2)
            Next
        Next
        On Error GoTo 0
        '
        Range("G1:H1").Font.Bold = False
        Range("G2:H" & iRowF).Value = ""
        Range("A1:B1").Copy Destination:=Range("K1:L1")
        If iIdx > 0 Then Range("K2").Resize(UBound(tOut, 2), 2).Value = WorksheetFunction.Transpose(tOut)
    End If
End If

A+

Bon, après 5 essais infructueux, "Service indisponible", je mettrai le fichier plus tard...

Va comprendre, maintenant, il veut bien...

Hello,

Déjà merci pour ton aide.

Ensuite, je comprends rien du tout.

Je suis censé faire quoi pour faire fonctionner le code ?
Je veux dire, j'ai ouvert ton fichier et ai essayé de cliquer sur une cellule en G pour qu'un "V" mais rien ne se passe. Pareil pour le clic droit sur G1 ect.
(Sachant que parmi ce que tu as expliqué, je ne pense utiliser que la colonne G, pas la H).

J'ai ensuite essayé de lancer ton code en rajoutant Sub test(), mais ça bug. Ca semble buguer au niveau de TriA.

Peux-tu me détailler les étapes que je suis censé faire pour que ça fonctionne ?

Merci.

Salut Kwns,

ah ? Déçu, je suis...
J'ai téléchargé le fichier de ma réponse, au cas où il aurait subi un dommage inattendu mais, non, tout fonctionne parfaitement.

Comme je lis que tu ne te serviras que du réglage en colonne [G:G] :
- un clic gauche en [G] en regard des critères souhaités de [F] inscrit un "V" ;
- un clic sur cette marque l'éteint, en cas d'erreur ;
- un clic DROIT en [G1] allume ou éteint toute la colonne [G] ;
- un double-clic en [G1] démarre le calcul de tri avec affichage en [K:L] pour autant qu'il y ait au moins UNE marque "V".

Je lis que tu as voulu lancer une macro 'Test', donc depuis un Module.
Mes macros sont quasiment toutes des macros événementielles : elles réagissent à un événement (clic-gauche, clic-droit, double-clic, change,...)
En gros, elles DOIVENT donc rester dans le module VBA de la feuille concernée avec, tant qu"à faire, les macros annexes.

Ça DOIT fonctionner comme je te le décris pour la structure de CE fichier : je n'ai pas vu d'erreur !

A+

C'est bon, j'ai réussi à faire fonctionner !
Top, merci.

Et si je pars d'une liste qui n'est pas triée, tout fonctionne pareil ?

Merci encore !

Bien sûr : un tri est fait pour la facilité du cerveau humain. L'ordi s'en fout royalement !

A+

Bonjour,

Alors, je suis désolé d'encore te déranger mais je me demandais si tu pouvais m'aider encore un petit peu si ça ne te dérange pas.

Voilà ce que j'aimerais exactement faire :

• Sur la Sheet1, dans les colonnes A,B,C, j'ai des données (tirées d'un autre dossier). On ne connait pas le nombre de lignes pour ces données. Ces données sont telles quelles : un ID complet (Pierre, Amandine ect...), un ID simplifié (Pier, Aman...) et une valeur numérique.
• La première étape serait de faire la somme des valeurs numériques pour chaque ID (comme dans les colonnes I et J de la Sheet1).
• Classer par ordre décroissant selon la colonne J.
• Dans la colonne K, pour chaque valeur de la colonne J à partir de J2, afficher le % total (c'est à dire pour K2 : la case J2 divisée par la somme des cases à partir de J2, pour K3 : la case J3 divisée par la somme des cases à partir de J2, ect)
• Dans la colonne L, afficher le pourcentage cumulé (c'est à dire pour L2 : on affiche K2, pour L3: on affiche K2 + K3, ect)
• Colorer en orange toutes les lignes dont le pourcentage cumulé est inférieur à 90% + aussi colorer en orange aussi la première ligne dont le pourcentage cumulé dépasse 90% (cf mon exemple)

Jusque là, c'est long mais je ne pense pas que ce soit très dur pour quelqu'un d'expérimenter (bien que je ne sache pas le faire). Ensuite ta macro entre en jeu ! Mais je n'arrive psa à la modifier suffisamment pour la faire faire ce que je veux. Ce qui serait bien ça serait que :

• A partir des ID colorés en orange dans la case I, Sheet 1, obtenir les ID_complet dans l'ordre sur une nouvelle Sheet (cf Sheet2).

Merci énormément d'avance, sincèrement désolé.

Après réflexion, l'idéale ça serait d'avoir deux macros.
La première qui donne le tableau de droite et la seconde qui donne le tableau de la Sheet2.

Salut Kwns,

évolution selon tes derniers posts sauf qu'il n'y a qu'UNE macro pour tout faire.
J'ai supprimé l'option "Ordre".
Á toi de me dire si je suis dans le bon.
Détail : 90% tout rond doit-il être considéré dans la catégorie "<90%" ou comme le 1er des ">90%" ?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab, tOut(), iRowA%, iRowF%, iRow%, iFlag%, iIdx%, sData$
'
Cancel = True
iRowA = Range("A" & Rows.Count).End(xlUp).Row
iRowF = Range("F" & Rows.Count).End(xlUp).Row
'Tri UP/DOWN colonne [A:B]
If Not Intersect(Target, [A1]) Is Nothing And [A3] <> "" Then _
    [A1].Font.Italic = IIf([A1].Font.Italic = True, False, True): _
    Call TriA(IIf([A1].Font.Italic = True, 1, 0))
'Tri UP/DOWN colonne [F:G]
If Not Intersect(Target, [F1]) Is Nothing And [F3] <> "" Then _
    [F1].Font.Italic = IIf([F1].Font.Italic = True, False, True): _
    Call TriF(IIf([F1].Font.Italic = True, 1, 0))
'Calculs résultats
If Not Intersect(Target, [G1]) Is Nothing And [A2] <> "" And [F2] <> "" Then
    iFlag = WorksheetFunction.CountA(Range("G2:G" & iRowF))
    If iFlag > 0 Then
        ReDim tOut(3, iFlag)
        Columns("J:N").Delete shift:=xlToLeft
        tTab = Range("A2:B" & iRowA).Value
        If [A3] <> "" Then Call TriA(IIf([F1].Font.Italic = False, 0, 1))
        '
        'Calculs des totaux et relevé des ID complets
        On Error Resume Next
        For x = 1 To iFlag
            iRow = Range("G1:G" & iRowF).Find(what:="P", lookat:=xlWhole, LookIn:=xlValues).Row
            Range("G" & iRow).Value = ""
            sData = Range("F" & iRow).Value
            For y = 1 To UBound(tTab, 1)
                If Left(tTab(y, 1), Len(sData)) = sData Then _
                    tOut(0, x - 1) = tTab(y, 1): _
                    tOut(1, x - 1) = sData: _
                    tOut(2, x - 1) = CInt(tOut(2, x - 1)) + CInt(tTab(y, 2))
            Next
        Next
        On Error GoTo 0
        'Préparation affichage résultats
        Range("J1:N1").Value = Array("ID complets", "ID", "Somme/ID", "% Total", "% Cumulés")
        Range("L2").Resize(UBound(tOut, 2), 1).NumberFormat = "0"
        Range("M2").Resize(UBound(tOut, 2), 2).NumberFormat = "0.00%"
        Range("J2").Resize(UBound(tOut, 2), 3).Value = WorksheetFunction.Transpose(tOut)
        Range("J1").Resize(UBound(tOut, 2) + 1, 3).Sort key1:=Range("L2"), order1:=xlDescending, Orientation:=xlTopToBottom, Header:=xlYes
        'Calculs des pourcentages
        For x = 2 To iFlag + 1
            Range("M" & x).Value = CDbl(CInt(Range("L" & x).Value) / WorksheetFunction.Sum(Range("L2").Resize(UBound(tOut, 2), 1)))
            Range("N" & x).Value = WorksheetFunction.Sum(Range("M2:M" & x))
            If Range("N" & x).Value < 0.9 Or (Range("N" & x).Value >= 0.9 And Range("N" & x - 1).Value < 0.9) Then _
                Range("K" & x).Resize(1, 4).Interior.Color = RGB(255, 190, 0): _
                iIdx = x
        Next
        'Affichage ID en 'ID'
        With Worksheets("ID")
            .Columns("A:B").Delete shift:=xlToLeft
            .Range("A1").Resize(iIdx, 2).Value = Range("J1").Resize(iIdx, 2).Value
            .Range("A1").Resize(iIdx, 2).Sort key1:=.Range("A2"), order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes
            'Bordures en 'ID'
            .Range("A1").Resize(iIdx, 2).Borders.LineStyle = xlContinuous
            .Range("A1").Resize(iIdx, 2).BorderAround Weight:=xlMedium
            .Range("A1:B1").Interior.Color = RGB(215, 215, 215)
        End With
        Columns(10).Value = ""
        'Bordures tableau résultats
        Range("K1").Resize(UBound(tOut, 2) + 1, 4).Borders.LineStyle = xlContinuous
        Range("K1").Resize(UBound(tOut, 2) + 1, 4).BorderAround Weight:=xlMedium
        Range("K1:N1").Interior.Color = RGB(215, 215, 215)
        'Réinitialisation Tableau [F:G]
        Range("G1").Font.Bold = False
        Range("G2:G" & iRowF).Value = ""
    End If
End If
'
End Sub

A+