Microsoft 365 tri des onglets selon une liste déterminée ou selon l'ordre alpha numérique

[Zarjoun]

Hello à tous,
je souhaiterais classer des onglets soit selon une liste soit par ordre alpha numérique....
j'ai bien une macro, mais elle tourne pendant plus de 30 min est ce "normal"?

de plus comment savoir le temps de progression de la macro?
d'avance merci ,

Sub tri_ongletDirect2()
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
For j = i To Sheets.Count
If IsNumeric(Sheets(j).Name) Then
x = String(30 - Len(Sheets(j).Name), "0") & Sheets(j).Name
Else
x = UCase(Sheets(j).Name)
End If
If IsNumeric(Sheets(i).Name) Then
y = String(30 - Len(Sheets(i).Name), "0") & Sheets(i).Name
Else
y = UCase(Sheets(i).Name)
End If
If x < y Then
Sheets(i).Move before:=Sheets(j)
Sheets(j).Move before:=Sheets(i)
End If
Next j
Next i
End Sub

 

[mapomme]

Bonjour @Zarjoun,

Sans avoir analysé votre code, sur ma bécane l'exécution de votre code se fait en moins de 0,4 secondes.

 

[sylvanu]

Bonjour,
En PJ un essai avec :
- Un tri alpha, ce tri est 0..9A..Z

Sub RangeOngletsOrdreAlpha()
    Dim tablo(), N%, i%, F
    Application.ScreenUpdating = False
    ' Redimensionner array avec nbre de feuilles
    N = Sheets.Count - 1
    ReDim tablo(N): i = 0
    ' Ranger les noms de feuilles dans l'array
    For Each F In Worksheets
        tablo(i) = F.Name: i = i + 1
    Next F
    ' Trier array 0..9 A..Z
    For i = 0 To N
        For j = 0 To N
            If tablo(i) < tablo(j) Then
                ' Swap des données dans l'array
                buffer = tablo(i): tablo(i) = tablo(j): tablo(j) = buffer
            End If
        Next j
    Next i
    ' Déplacer chaque feuille à la fin
    For i = 0 To N: Sheets(tablo(i)).Move After:=ActiveWorkbook.Sheets(Sheets.Count): Next i
    ' Repositionne Onglets en premier
    Sheets("Onglets").Move before:=ActiveWorkbook.Sheets(1)
    Application.ScreenUpdating = True
End Sub

- Un tri suivant liste en colonne E avec :

Sub RangeOngletsSuivantListe()
    Application.ScreenUpdating = False
    Dim NomFeuille$, L%
    For L = 5 To Range("E65500").End(xlUp).Row
        NomFeuille = CStr(Sheets("Onglets").Cells(L, "E"))
        If WsExist(NomFeuille) Then
            Sheets(NomFeuille).Move After:=ActiveWorkbook.Sheets(Sheets.Count)
        End If
    Next L
    Sheets("Onglets").Activate
    Application.ScreenUpdating = True
End Sub

 

[Zarjoun]

Bonjour @Zarjoun,

Sans avoir analysé votre code, sur ma bécane l'exécution de votre code se fait en moins de 0,4 secondes.

C'est peut être du au fait que j'ai allégé le fichier,

 

[Zarjoun]

C'est peut être du au fait que j'ai allégé le fichier,

un tout cas un grand merci

 

[Zarjoun]

Bonjour,
En PJ un essai avec :
- Un tri alpha, ce tri est 0..9A..Z

Sub RangeOngletsOrdreAlpha()
    Dim tablo(), N%, i%, F
    Application.ScreenUpdating = False
    ' Redimensionner array avec nbre de feuilles
    N = Sheets.Count - 1
    ReDim tablo(N): i = 0
    ' Ranger les noms de feuilles dans l'array
    For Each F In Worksheets
        tablo(i) = F.Name: i = i + 1
    Next F
    ' Trier array 0..9 A..Z
    For i = 0 To N
        For j = 0 To N
            If tablo(i) < tablo(j) Then
                ' Swap des données dans l'array
                buffer = tablo(i): tablo(i) = tablo(j): tablo(j) = buffer
            End If
        Next j
    Next i
    ' Déplacer chaque feuille à la fin
    For i = 0 To N: Sheets(tablo(i)).Move After:=ActiveWorkbook.Sheets(Sheets.Count): Next i
    ' Repositionne Onglets en premier
    Sheets("Onglets").Move before:=ActiveWorkbook.Sheets(1)
    Application.ScreenUpdating = True
End Sub

- Un tri suivant liste en colonne E avec :

Sub RangeOngletsSuivantListe()
    Application.ScreenUpdating = False
    Dim NomFeuille$, L%
    For L = 5 To Range("E65500").End(xlUp).Row
        NomFeuille = CStr(Sheets("Onglets").Cells(L, "E"))
        If WsExist(NomFeuille) Then
            Sheets(NomFeuille).Move After:=ActiveWorkbook.Sheets(Sheets.Count)
        End If
    Next L
    Sheets("Onglets").Activate
    Application.ScreenUpdating = True
End Sub

Vous êtes topissime