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
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 :/