Sub TrierCouleur_Dictionary() '1,56 seconde sur 60000 lignes
Dim t#, P As Range, coul As Object, i&
t = Timer
Set P = Range("A2:D" & Cells(Rows.Count, 3).End(xlUp).Row) 'plage à adapter
Set coul = CreateObject("Scripting.Dictionary")
For i = 1 To P.Rows.Count
coul(i) = P(i, 3).Interior.ColorIndex
Next
P(1, 4).Resize(coul.Count) = Application.Transpose(coul.items)
P.Sort P(1, 4), Header:=xlNo
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub
Sub TrierCouleur_Tableau() '1,33 seconde sur 60000 lignes
Dim t#, P As Range, coul, i&
t = Timer
Set P = Range("A2:D" & Cells(Rows.Count, 3).End(xlUp).Row) 'plage à adapter
coul = P.Columns(4)
For i = 1 To P.Rows.Count
coul(i, 1) = P(i, 3).Interior.ColorIndex
Next
P(1, 4).Resize(UBound(coul)) = coul
P.Sort P(1, 4), Header:=xlNo
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub
Sub TrierCouleur_Excel4() '0,72 seconde sur 60000 lignes
Dim t#, P As Range
t = Timer
Set P = Range("A2:D" & Cells(Rows.Count, 3).End(xlUp).Row) 'plage à adapter
ThisWorkbook.Names.Add "couleur", RefersToR1C1:="=GET.CELL(38,RC[-1])"
P.Columns(4) = "=couleur"
P.Columns(4) = P.Columns(4).Value 'supprime les formules
P.Sort P(1, 4), Header:=xlNo
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub