Re : VBA excel trier les feuilles dans l'ordre
j'ai repris ce programme générique.
Cependant
1. Les notes 10 et 12 sont toujours comprises entre celles 0 et 2
2. Le classement par ordre alphabétique ne fonctionne pas
Option Explicit
Sub TriFeuilles()
Dim i As Integer, ar
Dim RegExp As Object
Dim Ref As Double
Application.ScreenUpdating = False
ReDim ar(1 To Sheets.Count, 1 To 2)
For i = 1 To Sheets.Count
ar(i, 1) = ThisWorkbook.Sheets(i).Name
Next i
Set RegExp = CreateObject("VBScript.RegExp")
With RegExp
.MultiLine = False
.Global = False
.IgnoreCase = True
.Pattern = "(Note )(\d+(\.\d+)*)"
On Error Resume Next
For i = 1 To UBound(ar, 1)
If .test(ar(i, 1)) Then
Ref = WBSSortKey2(Split(.Execute(ar(i, 1))(0), " ")(1))
ar(i, 2) = .Replace(ar(i, 1), "$1" & Ref)
Else
ar(i, 2) = "ZZZZ" & ar(i, 1)
End If
Next i
End With
'Trier les feuilles
Sort2DVert ar, 2, "A"
For i = 1 To UBound(ar, 1)
Sheets(ar(i, 1)).Move before:=Sheets(i + 1)
Next i
Application.ScreenUpdating = True
End Sub
Function WBSSortKey2(v As Variant) As Double
Dim s() As String, i As Integer
s = Split(v, ".")
For i = 0 To UBound(s)
WBSSortKey2 = WBSSortKey2 + CDbl(s(i)) / 100# ^ i
Next
End Function
Public Sub Sort2DVert(avArray As Variant, iKey As Integer, sOrder As String, Optional iLow1, Optional iHigh1)
Dim iLow2 As Integer, iHigh2 As Integer, i As Integer
Dim vItem1, vItem2 As Variant
On Error GoTo PtrExit
If IsMissing(iLow1) Then iLow1 = LBound(avArray)
If IsMissing(iHigh1) Then iHigh1 = UBound(avArray)
iLow2 = iLow1: iHigh2 = iHigh1
vItem1 = avArray((iLow1 + iHigh1) \ 2, iKey)
Do While iLow2 < iHigh2
If sOrder = "A" Then
Do While avArray(iLow2, iKey) < vItem1 And iLow2 < iHigh1: iLow2 = iLow2 + 1: Loop
Do While avArray(iHigh2, iKey) > vItem1 And iHigh2 > iLow1: iHigh2 = iHigh2 - 1: Loop
Else
Do While avArray(iLow2, iKey) > vItem1 And iLow2 < iHigh1: iLow2 = iLow2 + 1: Loop
Do While avArray(iHigh2, iKey) < vItem1 And iHigh2 > iLow1: iHigh2 = iHigh2 - 1: Loop
End If
If iLow2 < iHigh2 Then
For i = LBound(avArray, 2) To UBound(avArray, 2)
vItem2 = avArray(iLow2, i)
avArray(iLow2, i) = avArray(iHigh2, i)
avArray(iHigh2, i) = vItem2
Next
End If
If iLow2 <= iHigh2 Then
iLow2 = iLow2 + 1
iHigh2 = iHigh2 - 1
End If
Loop
If iHigh2 > iLow1 Then Sort2DVert avArray, iKey, sOrder, iLow1, iHigh2
If iLow2 < iHigh1 Then Sort2DVert avArray, iKey, sOrder, iLow2, iHigh1
PtrExit:
End Sub