Tri par sélection, Tri à bulles

cibleo · 24 Novembre 2010

Bonsoir le forum,

Voici un algorithme difficile à résoudre et je ne sais vraiment pas comment m'y prendre.

Dans le fichier joint, j'ai 4 feuilles nommées comme ceci :

25 01 11 qui correspond au 25 janvier 2011
03 03 11 ---------> 03 mars 2011
15 06 10 ---------> 15 juin 2010
07 07 10 ---------> 07 juillet 2010

Je cherche à les trier par ordre chronologique soit :
15 06 10
07 07 10
25 01 11
03 03 11

Or la macro suivante effectue le tri comme ceci

03 03 11
07 07 10
15 06 10
25 01 11

Avec la notation yy mm dd, la macro effectue le tri correctement (comme me le précisait JNP) mais je souhaite garder la notation dd mm yy pour le format des onglets.

Code:

Private Sub TriFeuilles1()
Dim Bcle%, Index%, Sh As Object
'évidemment, les feuilles ne doivent pas être protégées !
On Error Resume Next
With ThisWorkbook
  For Each Sh In ThisWorkbook.Sheets
    If Sh.Index > 1 Then
      For Index = 2 To .Sheets.Count
        If LCase(Sh.Name) > LCase(.Sheets(Index).Name) And Sh.Index < Index Then
          Sh.Move , .Sheets(Index)
        End If
      Next Index
    End If
  Next Sh
End With
End Sub

Pouvez-vous m'aider à résoudre cet algoritme de tri ?
Bonne soirée Cibleo

Ps : dans le fichier initial, il n'y a qu'une trentaine de feuilles à trier au maximum.

kjin · 24 Novembre 2010

Re : Tri par sélection, Tri à bulles

Bonsoir,
A tester

Code:

For i = 1 To Sheets.Count
    wi = Sheets(i).Name
    di = CLng(DateSerial(Mid(wi, 7, 2), Mid(wi, 4, 2), Mid(wi, 1, 2)))
    For j = i To Sheets.Count
        wj = Sheets(j).Name
        dj = CLng(DateSerial(Mid(wj, 7, 2), Mid(wj, 4, 2), Mid(wj, 1, 2)))
        If dj < di Then
            Sheets(j).Move Before:=Sheets(i)
        End If
    Next
Next

A+
kjin

mromain · 24 Novembre 2010

Re : Tri par sélection, Tri à bulles

Bonsoir cibleo, kjin, le forum,

Une autre solution :

VB:

Sub TriFeuilles()
Dim tabFeuilles() As String, i As Long, j As Long, tmp As String
    
    With ThisWorkbook
    
        'récupérer les feuilles dans un tableau (le nom formaté en aammjj)
        ReDim tabFeuilles(2 To .Sheets.Count)
        For i = 2 To .Sheets.Count
            tabFeuilles(i) = Right(.Sheets(i).Name, 2) & Mid(.Sheets(i).Name, 4, 2) & Left(.Sheets(i).Name, 2)
        Next i
    
        'trier le tableau
        For i = LBound(tabFeuilles) To UBound(tabFeuilles) - 1
            For j = i + 1 To UBound(tabFeuilles)
                If tabFeuilles(j) < tabFeuilles(i) Then
                    tmp = tabFeuilles(j)
                    tabFeuilles(j) = tabFeuilles(i)
                    tabFeuilles(i) = tmp
                End If
            Next j
        Next i
        
        'replacer les feuilles
        For i = UBound(tabFeuilles) To LBound(tabFeuilles) Step -1
            .Sheets(Right(tabFeuilles(i), 2) & " " & Mid(tabFeuilles(i), 3, 2) & " " & Left(tabFeuilles(i), 2)).Move after:=.Sheets(1)
        Next i
        
    End With
End Sub

a+

ROGER2327 · 24 Novembre 2010

Re : Tri par sélection, Tri à bulles

Bonsoir à tous

Une autre proposition (car abondance de bien ne nuit pas) :

Code:

[COLOR=DarkSlateGray][B]Sub TriFeuilles1()
Dim Index%, Sh As Object
  With Application: .ScreenUpdating = 0: .Calculation = -4135: End With
  On Error Resume Next
  With ThisWorkbook
    For Each Sh In ThisWorkbook.Sheets
      If Sh.Name = "Modele" Then [COLOR=DarkOrange] 'Pour le cas où la première feuille[/COLOR]
        Sh.Move , 1               [COLOR=DarkOrange]'ne serait pas la feuille "Modele".[/COLOR]
      Else
        For Index = 1 To .Sheets.Count
          If CDate(Sh.Name) > CDate(.Sheets(Index).Name) And Sh.Index < Index Then Sh.Move , .Sheets(Index)
        Next Index
      End If
    Next Sh
  End With
  With Application: .Calculation = -4105: .ScreenUpdating = 1: End With
End Sub[/B][/COLOR]

ROGER2327
#4595

Dimanche 22 As 138 (Saint Lautréamont, SS)
4 Frimaire An CCXIX
2010-W47-3T22:56:16Z

JNP · 25 Novembre 2010

Re : Tri par sélection, Tri à bulles

Bonjour le fil

,
Encore une autre solution, faire le distingo entre le nom de l'onglet et son nom en temps qu'objet (.Name et .CodeName).
La macro de création de feuille comprendrait juste une ligne de plus :

Code:

For i = DateDebut To DateFin
    If Weekday(i, vbMonday) < 6 Then 'Sans samedis et dimanches
        If Not TestFeuil(Format(i, "dd mm yy")) Then
            Sheets("Modele").Copy After:=Worksheets(Worksheets.Count)
            With ActiveSheet
                .Name = Format(i, "dd mm yy") 'Mise en forme du nom de la feuille
                .[B1] = "Planning du " & Application.Proper(Format(i, "dddd dd mmmm yyyy")) 'Mise en forme du de la date en B1
               [COLOR=red][B].CodeName = Format(i, "yy mm dd") 'Mise en forme du nom objet de la feuille[/B][/COLOR]
            End With
        End If
    End If
Next

et le tri pourrait s'effectuer sur le CodeName

Code:

Private Sub TriFeuilles()
Dim Bcle%, Index%, Sh As Object
'évidemment, les feuilles ne doivent pas être protégées !
On Error Resume Next
With ThisWorkbook
  For Each Sh In ThisWorkbook.Sheets
    If Sh.Index > 1 Then
      For Index = 2 To .Sheets.Count
      [COLOR=red][B]  If LCase(Sh.CodeName) > LCase(.Sheets(Index).CodeName) And Sh.Index < Index Then[/B][/COLOR]
          Sh.Move , .Sheets(Index)
        End If
      Next Index
    End If
  Next Sh
End With
End Sub

Non testé

...
Bonne journée

cibleo · 25 Novembre 2010

Re : Tri par sélection, Tri à bulles

Bonjour à tous

J'ai testé à coups de F8 toutes les solutions, c'est tout bon pour Roger, mromain et kjin.
Roger c'est court et limpide.
J'ai plus de mal avec les 2 autres (les variables tableaux et manipuler les chaines de caractères, c'est toujours compliqué pour moi)
Y a plus qu'à choisir

Par contre JNP, je ne sais pas si l'on ne fait pas fausse route avec CodeName.
Pour tout dire, j'ai pas bien compris où tu voulais en venir

Pour info : j'obtiens ceci comme message :

Merci à vous tous Cibleo

ROGER2327 · 25 Novembre 2010

Re : Tri par sélection, Tri à bulles

Re…

cibleo à dit:
(…)
J'ai plus de mal avec les 2 autres (les variables tableaux et manipuler les chaines de caractères, c'est toujours compliqué pour moi)
(…)

Il est vrai que c'est rébarbatif au premier abord, mais ces techniques sont souvent très efficaces. Ça vaut le coup de s'y plonger !

ROGER2327
#4599

Lundi 23 As 138 (Saint Quincey, critique d'art, SQ)
5 Frimaire An CCXIX
2010-W47-4T11:23:51Z

JNP · 25 Novembre 2010

Re : Tri par sélection, Tri à bulles

Re

,

cibleo à dit:
Par contre JNP, je ne sais pas si l'on ne fait pas fausse route avec CodeName.
Pour tout dire, j'ai pas bien compris où tu voulais en venir

Une feuille a 2 noms, le nom de l'onglet (Name) et le nom de l'objet (CodeName). On fait référence à la feuille avec Sheets(Name) ou directement avec CodeName. Exemple :

Code:

Sheets("Feuil1").Select

est équivalent de

Code:

Feuil1.Select

parce qu'à la création, les 2 sont identiques.
Par contre, j'ai fait une erreur, CodeName est en lecture seule et ne peux être modifiée via VBA, seulement manuellement dans les propriétés

...
Donc, oublie ma proposition

...
Bonne journée

kjin · 25 Novembre 2010

Re : Tri par sélection, Tri à bulles

Bonjour,

JNP à dit:
Par contre, j'ai fait une erreur, CodeName est en lecture seule et ne peux être modifiée via VBA

Et comme ça...

Code:

ActiveWorkbook.VBProject.VBComponents("Feuil1").Name = "Titi"

A+
kjin

JNP · 25 Novembre 2010

Re : Tri par sélection, Tri à bulles

Re

,

kjin à dit:
Et comme ça...

Code:

ActiveWorkbook.VBProject.VBComponents("Feuil1").Name = "Titi"

Oui

, mais il me semble nécessaire de cocher :
Accès approuvé au modèle d'objet du projet VBA

.
Je sais pas si c'est vraiment plus simple

.
Mais effectivement

Code:

ActiveWorkbook.VBProject.VBComponents(.Name).Name = Format(i, "yy mm dd")

devrait fonctionner si elle remplace

Code:

[B][COLOR=#ff0000].CodeName = Format(i, "yy mm dd") 'Mise en forme du nom objet de la feuille[/COLOR][/B]

A +

kjin · 25 Novembre 2010

Re : Tri par sélection, Tri à bulles

Re,

JNP à dit:
mais il me semble nécessaire de cocher :
Accès approuvé au modèle d'objet du projet VBA

Pas sous 2000

Mais tu m'apprends que cette option a été rajoutée sur les versions supérieures
A+
kjin

Effectuez une recherche sur Excel Downloads...

Tri par sélection, Tri à bulles

cibleo

XLDnaute Impliqué

Pièces jointes

kjin

XLDnaute Barbatruc

mromain

XLDnaute Barbatruc

ROGER2327

XLDnaute Barbatruc

JNP

XLDnaute Barbatruc

cibleo

XLDnaute Impliqué

Pièces jointes

ROGER2327

XLDnaute Barbatruc

JNP

XLDnaute Barbatruc

kjin

XLDnaute Barbatruc

JNP

XLDnaute Barbatruc

kjin

XLDnaute Barbatruc

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums