Sub Tableaux()
Dim Plage, Entetes As Range, dico As Object, code, c, T(), clé, borne
Dim i&, j&, k&, l&, m As Byte, DerLig&
With Sheets("jour")
Set Plage = .Range("A2").CurrentRegion.Offset(1).Resize(.Range("A2").CurrentRegion.Rows.Count - 1, _
.Range("A2").CurrentRegion.Columns.Count - 1)
Set Entetes = .Range(.Cells(1, 1), .Cells(1, Plage.Columns.Count))
code = .Range("G2:G" & Plage.Rows.Count + 1)
Set dico = CreateObject("scripting.dictionary")
For Each c In code
dico(c) = dico(c) + 1
Next c
clé = dico.keys
borne = dico.items
Call Tri(clé, borne, 1, UBound(clé))
End With
With Sheets("Regionalisation")
.Range(.Cells(1, 1), .Cells(10000, Plage.Columns.Count)).Clear
For i = 1 To dico.Count
For j = 1 To UBound(code)
If code(j, 1) = clé(i - 1) Then
ReDim T(1 To borne(i - 1), 1 To Plage.Columns.Count)
m = 1
For k = 1 To Plage.Rows.Count
If code(k, 1) = clé(i - 1) Then
For l = LBound(T, 2) To UBound(T, 2)
T(m, l) = Plage(k, l)
Next l
m = m + 1
End If
Next k
End If
Next j
DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A" & DerLig + 1) = clé(i - 1)
.Range("A" & DerLig + 2).Resize(, Plage.Columns.Count) = Entetes.Value
.Range("A" & DerLig + 3).Resize(UBound(T), UBound(T, 2)) = T
Next i
End With
End Sub
Sub Tri(clé, borne, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = clé((gauc + droi) \ 2)
g = gauc: d = droi
Do
Do While clé(g) < ref: g = g + 1: Loop
Do While ref < clé(d): d = d - 1: Loop
If g <= d Then
temp = clé(g): clé(g) = clé(d): clé(d) = temp
temp = borne(g): borne(g) = borne(d): borne(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call Tri(clé, borne, g, droi)
If gauc < d Then Call Tri(clé, borne, gauc, d)
End Sub
