Microsoft 365 Tri d'une plage en fonction des commentaires (noyes)

Flac1

XLDnaute Nouveau
Bonjour,
Est-il possible de trier une plage en fonction des commentaires (notes) insérées dans les cellules d'une colonne.
Le petit triangle rouge dans le coin supérieur droit de la cellule dont le commentaire est visible quand on passe le curseur
sur la cellule.

Merci

Flac
 

Flac1

XLDnaute Nouveau
Bonjour,
Ci-joint le fichier utilisé pour la discussion.
Une macro WorkingSelection change est intégrée à la feuille "Cote"
Les cellules 1, 2 et 5 de la ligne sont colorées en bleu.
En cliquant sur une des trois cellules, voici ce qui se produit:
Cellule A2: la plage est triée par ordre alphabétique ascendant
Cellule E2: la plage est triée par ordre numérique descendant

Et c'est pour la cellule B2 que j'ai besoin d'aide.
Si on passe le curseur en regard des cellules de cette colonne, on remarque
qu'elles sont dotées d'un commentaire, soit Paul, Jean, Marc et Luc
Je voudrais que le tri se fasse en fonction du commentaire relatif aux cellules.

J'espère que c'est possible.
Merci de te rendre volontaire pour suggérer une solution à mon problème.

Bonne journée

Flac
 

Pièces jointes

  • testtri.xlsm
    64.9 KB · Affichages: 21

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour Flac, bonjour le forum,

Une proposition en pièce jointe. J'ai modifié l'événementielle Change :

VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ENDR As Integer
Dim DRAP As String, symbole As Range, VARIATION As Range, HIER As Range
Dim trouv

Target.Select
If Not Target.row = 2 Then Exit Sub
Application.EnableEvents = False
With Target
    Select Case .Column
        Case 1, 5
            ENDR = Target.Column
            Range("SYMB").Select
            If .Column = 1 Then
                Selection.Sort Key1:=Cells(3, ENDR), Order1:=xlAscending
            Else
                Selection.Sort Key1:=Cells(3, ENDR), Order1:=xlDescending
            End If
            Cells(3, 1).Select
        Case 2
            Module3.Macro1
    End Select
End With
Application.EnableEvents = True
Application.CutCopyMode = False
End Sub

Et rajouté la macro ci-dessous dans le module 3 :
Code:
Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variabe DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim CEL As Range 'déclare la variable CEL (CEllule)
Dim TP As Variant 'déclare la variable TP (Tableau des Prénoms)
Dim T As String 'déclare la variable T (Temporaire)
Dim TT() As Variant 'déclare la variable TT (tableau Trié)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set O = Worksheets("Cote") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, "A").End(xlUp).row 'définit la dernière ligne édité  DL de la colonne A de l'onglet O
Set PL = O.Range("B3:B" & DL) 'définit la plage PL
TP = O.Range("I3").CurrentRegion 'définit le tableau des prénoms TP
'tie alphabétique des orénoms
For I = 1 To UBound(TP, 1) 'boucle 1 : sur tous les prénoms du tableau des prénoms TP
    For J = 1 To UBound(TP, 1) 'boucle 2 : sur tous les prénoms du tableau des prénoms TP
        'si I est différent de J est si le prénom I est supérieur au prénom J, inverse la position des prénoms dans TP
        If I <> J And TP(I, 1) < TP(J, 1) Then T = TP(I, 1): TP(I, 1) = TP(J, 1): TP(J, 1) = T
    Next J 'prochain prénom de la boucle 2
Next I 'prochain prénom de la boucle 1
ReDim Preserve TT(1 To UBound(TP, 1), 1 To 2) 'redimensionne le tableau trié TT (autant de lignes que TP en a, 2 colonne)
For I = 1 To UBound(TP, 1) 'boucle sur toutes les lignes du tableau trié TT
    TT(I, 1) = TP(I, 1) 'récupère le prénom de TP dans la colonne 1 de TT
    TT(I, 2) = I 'récupère I dans la colonne 2 de TT
Next I 'prochaine igne de la boucle
For Each CEL In PL 'boucle 1 : sur toutes les cellue CEL de la plage PL
    For I = 1 To UBound(TT, 1) 'boucle 2 sur toutes les lignes I du tablrau trié TT
        On Error GoTo suite 'gestion des erreurs, si la cellule CEL ne contient pas de commentaire (en cas d'erreur va à l'étiquette "suite")
        If CEL.Comment.Text = TT(I, 1) Then CEL.Offset(0, 4).Value = TT(I, 2): Exit For 'si le commentaire de la cellue CEL est égal au prénom du tableau trié, renvoie le numéro dans la celllue en colonne F, sort de la boucle 2
    Next I 'prochaine ligne de la boucle 2
suite: 'étiquette
Next CEL 'prochaine celule de la boucle 1
O.Range("A2").CurrentRegion.Sort O.Range("F2"), xlAscending, Header:=xlYes 'tri les données par rapport à la colonne F
O.Columns(6).ClearContents 'efface le contenu de la colonne F
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Le fichier :
 

Pièces jointes

  • Flac_ED_v01.xlsm
    56.6 KB · Affichages: 4

Discussions similaires

Statistiques des forums

Discussions
311 735
Messages
2 082 024
Membres
101 873
dernier inscrit
excellllll