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

Zarjoun

XLDnaute Nouveau
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
 
Solution
Bonjour,
En PJ un essai avec :
- Un tri alpha, ce tri est 0..9A..Z
VB:
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...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour,
En PJ un essai avec :
- Un tri alpha, ce tri est 0..9A..Z
VB:
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 :
Code:
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
 

Pièces jointes

  • test renommer des feuilles (3) (2).xlsm
    911.5 KB · Affichages: 8

Zarjoun

XLDnaute Nouveau
Bonjour,
En PJ un essai avec :
- Un tri alpha, ce tri est 0..9A..Z
VB:
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 :
Code:
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 ;)
 

Discussions similaires

Réponses
0
Affichages
83

Statistiques des forums

Discussions
311 741
Messages
2 082 055
Membres
101 882
dernier inscrit
XaK_