Tri feuilles selon mois et année

Résolu/Fermé
thealchemyst Messages postés 18 Date d'inscription jeudi 11 septembre 2014 Statut Membre Dernière intervention 30 mars 2015 - 3 oct. 2014 à 10:19
thealchemyst Messages postés 18 Date d'inscription jeudi 11 septembre 2014 Statut Membre Dernière intervention 30 mars 2015 - 6 oct. 2014 à 11:35
Bonjour,

je voulais savoir s'il était possible de trier des feuilles
 selon le mois et l'année.


En faite, je demande à l'utilisateur, par InputBox d'entrer le nom du mois correspondant et une autre, l'année (Worksheets(1).Name = repmois & repannee).

Ce qui donne "février2013, janvier2014, avril2012" (les données à comparer sont sur trois années).

J'ai bien ce code pour le tri des mois :

Sub trionglet()

'Tri feuilles selon mois

y = 2 'la première feuille est mon formulaire
For x = 1 To 12 'pour les trois ans 1 To 36
For Each fl In Worksheets
If LCase(fl.Name) = LCase(MonthName(x)) Then
fl.Move before:=Sheets(y): y = y + 1
End If
Next fl
If y = Sheets.Count Then Exit For
Next x

End Sub

Mais je ne trouve pas l'équivalent pour les trier de cette façon "avril2012, février2013, janvier2014.

Cela est-il possible ou dois-je m'y prendre différemment ?

D'avance, merci de vos réponses.

3 réponses

PlacageGranby Messages postés 393 Date d'inscription mercredi 26 mars 2014 Statut Membre Dernière intervention 7 mars 2019 26
Modifié par pijaku le 3/10/2014 à 15:34
Bonjour,

Je te joint l'algo que j'ai pour trier mes onglets.

Sub SortWorksheets()
     
'////////////////////////////////////////
'// Algorithme de tri pour les onglets //
'////////////////////////////////////////
     
    Dim N As Integer
    Dim M As Integer
    Dim FirstWSToSort As Integer
    Dim LastWSToSort As Integer
    Dim SortDescending As Boolean
     
    SortDescending = False
     
    If ActiveWindow.SelectedSheets.Count = 1 Then
         
         'Change the 1 to the worksheet you want sorted first
        FirstWSToSort = 1
        LastWSToSort = Worksheets.Count
    Else
        With ActiveWindow.SelectedSheets
            For N = 2 To .Count
                If .Item(N - 1).Index <> .Item(N).Index - 1 Then
                    MsgBox "You cannot sort non-adjacent sheets"
                    Exit Sub
                End If
            Next N
            FirstWSToSort = .Item(1).Index
            LastWSToSort = .Item(.Count).Index
        End With
    End If
     
    For M = FirstWSToSort To LastWSToSort
        For N = M To LastWSToSort
            If SortDescending = True Then
                If UCase(Worksheets(N).Name) > UCase(Worksheets(M).Name) Then
                    Worksheets(N).Move Before:=Worksheets(M)
                End If
            Else
                If UCase(Worksheets(N).Name) < UCase(Worksheets(M).Name) Then
                    Worksheets(N).Move Before:=Worksheets(M)
                End If
            End If
        Next N
    Next M
     
End Sub



Si tu as une feuille formulaire que tu veux garder en premier, tu peux toujours tricher un peu et la renommer _Formulaire le underscore va faire en sorte qu'elle sera toujours première.

Mon exemple c'est un sort alphabétique seulement, mais j'imagine que tu peux le bidouiller un peu. Si ca ne fonctionne pas, je regarderai ca plus tard.
0
eriiic Messages postés 24571 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 8 mai 2024 7 216
3 oct. 2014 à 23:48
Bonjour,

il faudra que tu ajoutes un espace entre le mois et l'année :
Sub triOngletsDate()
    'tri par date sur nom d'onglet
   Dim sh As Worksheet
    Dim nom(), tmp(2), cpt As Long, fini As Boolean, depl As Boolean

    ReDim nom(1 To 2, 1 To 1)
    For Each sh In Worksheets
        ' recup onglets date
       If IsDate(sh.Name) Then
            cpt = cpt + 1
            ReDim Preserve nom(1 To 2, 1 To cpt)
            nom(1, cpt) = sh.Name
            nom(2, cpt) = CDate(sh.Name)
        End If
    Next sh

    ' tri à bulle
   Do
        fini = True
        For cpt = 2 To UBound(nom, 2)
            If nom(2, cpt) < nom(2, cpt - 1) Then
                tmp(1) = nom(1, cpt): tmp(2) = nom(2, cpt)
                nom(1, cpt) = nom(1, cpt - 1): nom(2, cpt) = nom(2, cpt - 1)
                nom(1, cpt - 1) = tmp(1): nom(2, cpt - 1) = tmp(2)
                fini = False
                depl = True
            End If
        Next cpt
    Loop Until fini
    ' déplacer
   If depl Then
        Application.ScreenUpdating = False
        For cpt = 1 To UBound(nom, 2)
            Sheets(nom(1, cpt)).Move After:=Sheets(Sheets.Count)
        Next cpt
    End If
End Sub 

eric
0
thealchemyst Messages postés 18 Date d'inscription jeudi 11 septembre 2014 Statut Membre Dernière intervention 30 mars 2015
6 oct. 2014 à 11:35
Merci PlacageGranby et Eriiic pour votre intérêt à mon problème.

J'ai testé les deux codes et les ils marchent parfaitement, mais celui d'Eriiic correspond mieux à ce que je recherchais. J'ai modifié mon code de base en ajoutant à Worksheets(1).Name = repmois & " " & repannee et ça marche du tonnerre :).

Merci encore pour votre aide, je pense que je vais réutiliser ton code PlacageGranby et le bidouiller, je pourrai l'utiliser pour d'autres projets, merci.
0