Trier les onglets d'un classeur

Comment trier par ordre alphabétique les onglets de mon fichier ?

Voilà une macro avec un algorithme de tri très rapide, triant par ordre alphanumérique les *groupes* de feuilles qui commencent par les mêmes chaînes de caractères, et opérant à l'intérieur de ces groupes un tri numérique sur les fins de noms.
Si ton classeur contient les feuilles Zaza26, Zaza15, JPS69, 2000, 19, JPS49287, Zaza4 et Feuil10, elles seront triées en: 19, 2000, Feuil10, JPS69, JPS49287, Zaza4, Zaza15 et Zaza26.

Dim Arr(), Idx() As Integer  Dim Elt1, Elt2, IdxTemp As Integer  Dim I As Integer    
sub TriFeuilles()
  Dim J As Integer, NF As Integer
  Dim Nom() As String
  Dim Calc As Long
 
  NF = Sheets.Count
  ReDim Nom(1 To NF)
  ReDim Arr(1 To NF, 1 To 2)
  For I = 1 To NF
   Nom(I) = Sheets(I).Name
   For J = Len(Nom(I)) To 1 Step -1
    If Not IsNumeric(Mid$(Nom(I), J, 1)) Then Exit For
   Next J
   If J = Len(Nom(I)) Then
    Arr(I, 1) = Nom(I)
   Else
    Arr(I, 1) = Left$(Nom(I), J)
    Arr(I, 2) = CLng(Mid$(Nom(I), J + 1))
   End If
 
 Next I
  ReDim Idx(1 To NF)
  For I = 1 To UBound(Idx)
   Idx(I) = I
 
 Next I
  Tri 1, NF
  Erase Arr
  Calc = Application.Calculation
 
 Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  For I = 1 To NF
   Sheets(Nom(Idx(I))).Move Sheets(I)
  Next I
 
 Application.Calculation = Calc
 
 end sub
Private sub Tri(ByVal B1 As Integer, ByVal H1 As Integer)
 
  Dim B2 As Integer
  Dim H2 As Integer
 
 
 B2 = B1
  H2 = H1
  Elt1 = Arr(Idx((B1 + H1) \ 2), 1)
  Elt2 = Arr(Idx((B1 + H1) \ 2), 2)
  Do While B2 < H2
   Do While B2 < H1
    If Arr(Idx(B2), 1) > Elt1 Then Exit Do
    If Arr(Idx(B2), 1) = Elt1 Then _
     If Arr(Idx(B2), 2) >= Elt2 Then Exit Do
    B2 = B2 + 1
   Loop
   Do While
 H2 > B1
    If Arr(Idx(H2), 1) < Elt1 Then Exit Do
    If Arr(Idx(H2), 1) = Elt1 Then _
     If Arr(Idx(H2), 2) <= Elt2 Then Exit Do
    H2 = H2 - 1
   Loop
   If B2 < H2 Then
    IdxTemp = Idx(B2)
    Idx(B2) = Idx(H2)
    Idx(H2) = IdxTemp
   End If
   If B2 <= H2 Then
     B2 = B2 + 1
     H2 = H2 - 1
   End If
  Loop
  If H2 > B1 Then Tri B1, H2
 
 If B2 < H1 Then Tri B2, H1
 
 end sub

Astuce illustrée par ce classeur
dma-trionglets

Auteur :

Mots clefs associés à cette page : , , , ,