Trier plusieurs groupes dans 1 ordre croissant

Bonjour à tous,

Mes données se trouvent dans la feuille "Impression" principalement dans le range ("A2 :I") & Dernière ligne.

Ce range, se compose de plusieurs groupes, chaque groupe se compose de trois lignes qui se suivent, pour plus de visibilité, j’ai coloré tous les groupes de couleur différentes, normalement les groupes ne sont pas colorés.

Comment déterminer les groupes ?

Un Groupe se distingue d’un autre groupe par le contenu de ses cellules en colonne "B", c-à-d que chaque groupe à des cellules identiques dans la colonne "B"

Ce que je souhaite faire, c’est trier tous les groupes dans un ordre croissant sur la colonne "A" en se basant sur la valeur de la première cellule de de la colonne "A" de chaque groupe, c-à-d "A2", "A5", "A8", "A11" ….. jusqu’à "A59".

Sauf erreur de ma part, vous trouverez le résultat souhaité dans la feuille "Résultat", le résultat final doit figurer sur la feuille "Impression" et non la feuille "Résultat"

Je reste à votre disposition pour d’autres informations supplémentaire au besoin.

Je vous remercie d’avance pour vos contributions.

Salut Harzer,

Sub TrierGroupesParNumeroDeCage()
'
Dim tTab
'
Application.ScreenUpdating = False
'
With Worksheets("Impression")
    tTab = .Range("A2:A" & .Range("B" & Rows.Count).End(xlUp).Row).Value
    For x = 1 To UBound(tTab, 1)
        If tTab(x, 1) <> "" Then tTab(x, 1) = Split(tTab(x, 1), " ")(1)
        If tTab(x, 1) = "" Then tTab(x, 1) = tTab(x - 1, 1)
    Next
    .Range("A2:A" & .Range("B" & Rows.Count).End(xlUp).Row).Value = tTab
    .Range("A2:I" & .Range("B" & Rows.Count).End(xlUp).Row).Sort _
        key1:=.Range("A2"), order1:=xlAscending, _
        Orientation:=xlTopToBottom, Header:=xlNo
    tTab = .Range("A2:A" & .Range("B" & Rows.Count).End(xlUp).Row).Value
    For x = 1 To UBound(tTab, 1) Step 3
        tTab(x, 1) = "Cage " & tTab(x, 1)
        tTab(x + 1, 1) = ""
        tTab(x + 2, 1) = ""
    Next
    .Range("A2:A" & .Range("B" & Rows.Count).End(xlUp).Row).Value = tTab
End With
'
Application.ScreenUpdating = True
'
End Sub

A+

Bonjour Curulis.

Je suis très content de te retrouver.

Merci pour ton retour et le code proposé, C’est vraiment ce que j’attendais.

Le code proposé fonctionne très bien et me donne le résultat souhaité, bravo.

Toutefois, Puis-je me permettre de te demander de commenter le code car il y’a des passages que je ne comprends pas le bon fonctionnement.

Je te remercie pour cette aide appréciable.

Amitiés.

Salut Harzer,

voilà les commentaires.

Sub TrierGroupesParNumeroDeCage()
'
'Pour trier ce genre de tableau, il faut remplir toutes les lignes vides
'Cage 1 étant une STRING, en le laissant ainsi, VBA va trier de cette façon
'Cage 1
'Cage 10
'Cage 11
'Cage 2
'Cage 20
'...
'Je transforme donc "Cage 1" en "1" et remplit les deux cellules du groupe avec ce même "1", etc...
'Après le tri, je retransforme les "1" en "Cage 1" et vide les deux cellules suivantes pour obtenir l'affichage original
'
'CQFD
'
Dim tTab
'
Application.ScreenUpdating = False
'
With Worksheets("Impression")
    tTab = .Range("A2:A" & .Range("B" & Rows.Count).End(xlUp).Row).Value    'colonne [A] : intitulés cages
    For x = 1 To UBound(tTab, 1)
        If tTab(x, 1) <> "" Then tTab(x, 1) = Split(tTab(x, 1), " ")(1)     'je garde le chiffre de la cage
        If tTab(x, 1) = "" Then tTab(x, 1) = tTab(x - 1, 1)                 'si cellule vide, je prends la valeur de la cellule au-dessus
    Next
    .Range("A2").Resize(UBound(tTab, 1), 1).Value = tTab                    'Affichage des chiffres correspondant aux cages
    'Tri ascendant
    .Range("A2:I" & .Range("B" & Rows.Count).End(xlUp).Row).Sort _
        key1:=.Range("A2"), order1:=xlAscending, _
        Orientation:=xlTopToBottom, Header:=xlNo
    '
    tTab = .Range("A2:A" & .Range("B" & Rows.Count).End(xlUp).Row).Value    'je reprends la colonne des chiffres ainsi triée
    For x = 1 To UBound(tTab, 1) Step 3                                     'je la parcours par bloc de 3 : STEP 3
        tTab(x, 1) = "Cage " & tTab(x, 1)                                   '1ere cellule du bloc = "Cage " + le chiffre
        tTab(x + 1, 1) = ""                                                 'les deux cellules suivantes sont vidées
        tTab(x + 2, 1) = ""
    Next
    .Range("A2").Resize(UBound(tTab, 1), 1).Value = tTab                    'restitution de l'affichage original
End With
'
Application.ScreenUpdating = True
'
End Sub

Bonne soirée!

A+

Bonjour Curulis.

On ne peut plus clair, je comprends beaucoup mieux lorsque le code est commenté.

Très bonne soirée et au plaisir de te relire à l’occasion.

Merci beaucoup.

Salut Harzer,

une bonne habitude à prendre!

A+