Trier des lignes par groupe

Bonjour,

Je cherche à trier plusieurs groupes de lignes entre eux, selon la première case de chaque groupe de ligne.

Je souhaite trier selon la colonne encadrée en rouge (la B). Les cases pointées d'une flèche bleue sont celles qui seront utilisées pour le tri, les autres informations étant dans les colonnes après.

Je voudrais donc savoir s'il était possible, lors du tri de chaque ENTREPRISE, que le lot de ligne encadré en orange reste tel qu'il est.

Actuellement, avec le code à la fin de ce message, le tri ne trie que les premières lignes de chaque bloc orange.

Quelqu'un sait-il si cela est possible s'il vous plaît ?

Merci d'avance et bonne journée à tous.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 11 Then Exit Sub 'si le changement n'a pas lieu dans la colonne I, sort de la procédure
If Target.Offset(0, -1).Value = "" Then Exit Sub 'si la colonne A est vide sort de la procédure tri

Range("B8").CurrentRegion.Sort Key1:=Range("B8"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

End Sub
51exemple.xlsm (301.39 Ko)

Bonjour

Il n'est pas possible de trier par bloc sauf à ajouter des colonnes éventuellement masquées avec des valeur permettant le tri.

Tu peux le faire par boucle VBA mais c'est un peu usine à GAZ...

Bonjour à tous,

A tester sur une copie de tes données

Attention au nom de la feuille à traiter, ici c'est celle placée en 1ère position dans ton classeur

Option Explicit
Sub test()
Dim rng As Areas, r As Range, i As Long, SL As Object
    Application.ScreenUpdating = False
    Set SL = CreateObject("System.Collections.SortedList")
    With Sheets(1)    'feuille à traiter
        Set rng = .Range("b7:b" & .Range("c" & Rows.Count).End(xlUp).Row).SpecialCells(2).Areas
    End With
    For Each r In rng
        SL(r.Value) = r.Resize(4, 13).Value
    Next
    For i = 1 To rng.Count
        rng(i).Resize(4, 13).Value = SL.GetByIndex(i - 1)
    Next
    Set rng = Nothing
    Set SL = Nothing
    Application.ScreenUpdating = True
End Sub

Les blocs à trier sont-ils tous composés de 4 lignes

klin89

Re Swicks,

Une variante :

Option Explicit
Sub test1()
Dim rng As Range, i As Long, n As Long, SL As Object
    Application.ScreenUpdating = False
    Set SL = CreateObject("System.Collections.SortedList")
    With Sheets(1)    'feuille à traiter
        Set rng = .Range("b7:b" & .Range("c" & Rows.Count).End(xlUp).Row).SpecialCells(4)
        With rng
            For i = 1 To .Areas.Count
                With .Areas(i)
                    SL(.Cells(0).Value) = .Cells(0).Resize(.Rows.Count + 1, 13).Value
                End With
            Next
        End With
        n = 7
        '.Range("b6").CurrentRegion.Offset(1).ClearContents
        For i = 0 To SL.Count - 1
            .Cells(n, 2).Resize(UBound(SL.GetByIndex(i), 1), 13) = SL.GetByIndex(i)
            n = n + UBound(SL.GetByIndex(i), 1)
        Next
    End With
    Set rng = Nothing
    Set SL = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

Bonjour à tous,

A tester sur une copie de tes données

Attention au nom de la feuille à traiter, ici c'est celle placée en 1ère position dans ton classeur

Les blocs à trier sont-ils tous composés de 4 lignes

klin89

Merci pour ta réponse, et oui

Re Swicks,

Une variante :

klin89

Super merci beaucoup !

re Swicks,

Plus simplement

Option Explicit
Sub test2()
Dim i As Long, n As Long, derlig As Long, SL As Object
    Application.ScreenUpdating = False
    Set SL = CreateObject("System.Collections.SortedList")
    With Sheets(1)    'feuille à traiter
        derlig = .Range("c" & .Rows.Count).End(xlUp).Row
        For i = 7 To derlig Step 4
            SL(.Cells(i, 2).Value) = .Range(.Cells(i, 2), .Cells(i + 3, 14)).Value
        Next
        n = 7
        For i = 0 To SL.Count - 1
            .Cells(n, 2).Resize(UBound(SL.GetByIndex(i), 1), 13) = SL.GetByIndex(i)
            n = n + UBound(SL.GetByIndex(i), 1)
        Next
    End With
    Set SL = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

Bonjour,

Merci mais cela ne marche pas :/

Rechercher des sujets similaires à "trier lignes groupe"