Ordonner selon certaines conditions

[Magic_Doctor]

Bonsoir,
Je suis à la recherche de la solution suivante :
J’ai 2 colonnes contiguës. L’une avec des noms, l’autre avec des dates de naissance, par ex. :
Zaza 26/12/1957
Lolo 13/04/1988
Toto 18/11/1944
Bibi 14/01/1995
Juju 15/01/2005

Je voudrais, par macro, faire un classement en fonction des dates (mois + jour du mois) mais sans tenir compte des années. Par conséquent, je désirerais que ma liste ordonnée soit ainsi :

Bibi 14/01/1995
Juju 15/01/2005
Lolo 13/04/1988
Toto 18/11/1944
Zaza 26/12/1957

Merci pour tout coup de main.

 

[job75]

Re : Ordonner selon certaines conditions

Re,

Une autre solution est de récupérer dans tablo la valeur numérique de la date en utilisant .Value2.

Il n'est plus nécessaire d'utiliser CDate (s'il s'agit bien de valeurs numériques).

A+

 

[ROGER2327]

Re : Ordonner selon certaines conditions

Re... ...bonjour à tous

Qu'advient-il si Roger2327 est né le 29 février 2008 ?​

ROGER2327

 

[Catrice]

Re : Ordonner selon certaines conditions

Re,

Bonne remarque.
Quelle idée de naitre un 29 fevrier 😀

Dans ma proposition, le fait de recomposer la date avec l'année 2000 doit gérer cette exception. 2000 étant bissextile.

Edit 1 : Pour celle de Job75, en changeant :
cel = Format(cel, "mm/dd")
en
cel = DateSerial(2000, Month(cel), Day(cel))
Ca a l'air de fontionner ...

Edit 2 : Voir le Post de Job75 😉

 

[job75]

Re : Ordonner selon certaines conditions

Re,

Très juste Roger, il faut faire le tri en prenant une année bissextile comme le dit Catrice :

Sub test()
Dim tablo(), cel As Range
Application.ScreenUpdating = False
With Range("A2", Range("B65536").End(xlUp))
tablo = .Value2
For Each cel In .Resize(, 1).Offset(, 1)
cel = Format(cel, "mm/dd/2008") 'ou toute année bissextile
Next
.Resize(, 3).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo
For Each cel In .Resize(, 1)
cel.Offset(, 1) = Application.VLookup(cel, tablo, 2, 0)
[COLOR="Red"]If cel = "" Then cel.Offset(, 1) = "" 'supprime #N/A[/COLOR]
Next
End With
End Sub

Voir la date de naissance de Juju dans le fichier.

Edition : ajouté ligne en rouge en cas de cellule/ligne vide.

A+

 

[job75]

Re : Ordonner selon certaines conditions

Re (joke pour les initiés),

Heureusement Roger qu'il y a très peu de chance que Juju soit né le 29/02/1900 😀

A+

 

[Catrice]

Re : Ordonner selon certaines conditions

Re,Re,

A noter que les homonymes nés à différentes dates ne sont pas traités.

 

[Magic_Doctor]

Re : Ordonner selon certaines conditions

Bonjour à tous et merci à Catrice, Roger2327 & Job75,

Bravo Job75 pour ta solution qui marche parfaitement.
Je n'ai en revanche pas très bien compris la syntaxe (Value2 ???)...

Je n'y ai fait que quelques modifications mineures.

Très bonne journée à tous.

 

[job75]

Re : Ordonner selon certaines conditions

Bonsoir le fil,

A noter que les homonymes nés à différentes dates ne sont pas traités.

La solution suivante traite aussi bien les homonymes, on n'utilise plus VLookup :

Sub test()
Dim tablo(), cel As Range
Application.ScreenUpdating = False
With Range("B2", Range("B65536").End(xlUp))
tablo = Application.Transpose(.Value2)
For Each cel In .Offset(, -1)
cel = cel.Row - 1 & Chr(1) & cel
cel.Offset(, 1) = Format(cel.Offset(, 1), "mm/dd/2008") 'ou toute année bissextile
Next
.Offset(, -1).Resize(, 3).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo
For Each cel In .Offset(, -1)
cel.Offset(, 1) = tablo(Split(cel, Chr(1))(0))
cel = Split(cel, Chr(1))(1)
Next
End With
End Sub

Edit : oublié de supprimer une ligne dans la 1ère boucle For...

A+

 

[Magic_Doctor]

Re : Ordonner selon certaines conditions

Re

Mais qu'advient-il si une ligne est vide ?

Zaza ... 26/12/1957 ... 51 ans
Lolo .... 13/04/1988 ... 21 ans

Bibi ..... 14/01/1995 ... 14 ans
Juju .... 15/01/2005 ... 4 ans

 

[job75]

Re : Ordonner selon certaines conditions

Re,

Magic Doctor, il faut tester : si une ligne est vide il n'y a pas de problème.

Le tri renvoie cette ligne en bas du tableau.

PS : j'ai fait un Edit sur mon précédent post, j'avais laissé trainer une ligne inutile...

A+

 

[job75]

Re : Ordonner selon certaines conditions

Bonjour Magic Doctor, le fil, le forum,

J'ai modifié la macro de mon post #19.

Il faut noter que pour un grand nombre de lignes (>1000) cette macro est très lente à cause de VLookup.

Définitivement, il faut préférer la macro de mon post #23.

A+

 

[ChTi160]

Re : Ordonner selon certaines conditions

Salut Magic_Doctor
Bonsoir le Fil (en particulier job75)
Bonsoir le Forum

une autre version Vba sans commentaires , mais on peut y remédier lol

[COLOR=Blue]Sub TriAnniversaire[/COLOR]()
 Dim DerLgn As Long, PreLgn As Long
 Application.ScreenUpdating = False
     
 With ActiveSheet
 DerLgn = .Range("A" & .Rows.Count).End(xlUp).Row
 PreLgn = .UsedRange.Row + 1
          .UsedRange.Sort Key1:=.Range("A" & PreLgn), Order1:=xlAscending, Header:=xlYes
 DerLgn = .Range("A" & .Rows.Count).End(xlUp).Row
          .Range("D" & PreLgn, "D" & DerLgn).FormulaR1C1 = "=DAY(RC[-2])"
          .Range("E" & PreLgn, "E" & DerLgn).FormulaR1C1 = "=MONTH(RC[-3])"
          .Range("A" & PreLgn - 1, "E" & DerLgn).Sort Key1:=.Range("E" & PreLgn), _ 
              Order1:=xlAscending, Key2:=.Range("D" & PreLgn), _
              Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
              Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers, _
              DataOption2:=xlSortTextAsNumbers
          .Range("D:E").ClearContents
  End With
 Application.ScreenUpdating = True
 [COLOR=Blue]End Sub[/COLOR]

Bonne fin de Soirée

 

[Magic_Doctor]

Re : Ordonner selon certaines conditions

Bonsoir Job75,

J'ai bataillé un bon moment avec ta 2ème version que tu recommandes.
Le problème est que si je rajoute dans la feuille des lignes et des colonnes (dans ma feuille les colonnes ne se retrouveront pas forcément au même endroit que sur la tienne), j'ai beau modifier la macro en conséquence, elle bloque sur :
cel.Offset(, 1) = tablo(Split(cel, Chr(1))(0))

dont, à vrai dire, je ne comprends strictement pas la quintesence du sens.

C'est la raison pour laquelle j'ai pris pour habitude de toujours nommer les cellules qui apparaîtront dans mes macros pour ne pas devoir sans cesse les corriger au cas où je modifie le nombre de lignes et/ou de colonnes.
Mais peut-être ai-je tort de procéder ainsi...

Si tu me lis, pourrais-tu m'expliquer comment résoudre ce problème que, curieusement, je ne rencontre pas avec ta 1ère version ; mais puisque tu me conseilles d'utiliser la 2ème.

Buenas noches y hasta pronto.

Magic_Doctor que se está hielando los quinotos en el maldito Pampero.

 

[job75]

Re : Ordonner selon certaines conditions

Bonjour Magic doctor, le fil, le forum,

Je pense que ton problème vient de :

cel = cel.Row - 1 & Chr(1) & cel

Cette instruction est valable si le tableau commence en B2.

S'il commence en B1 il faut écrire :

cel = cel.Row & Chr(1) & cel

Et s'il commence en B3 :

cel = cel.Row - 2 & Chr(1) & cel

A+

 

[Catrice]

Re : Ordonner selon certaines conditions

Bonjour à tous,

Ci-joint mon code modifié qui gère les lignes vides, les homonymes et où début indique la colonne (cellule de départ) référence à traiter.

Sub test1()
Application.ScreenUpdating = False
Debut = "B2"
With ActiveSheet
    Set MaZone = .Range(.Range(Debut), .Cells(65536, .Range(Debut).Column).End(xlUp))
    For Each X In MaZone
        If X <> "" Then X.Value = CDbl(DateSerial(2000, Month(X), Day(X))) & "-" & Year(X)
    Next
    .Range(Debut).CurrentRegion.Resize(MaZone.Rows.Count).Sort Key1:=.Range(Debut), Order1:=xlAscending
    For Each X In Range(.Range(Debut), .Range(Debut).End(xlDown))
        X.Value = DateSerial(Split(X, "-")(1), Month(Split(X, "-")(0)), Day(Split(X, "-")(0)))
    Next
End With
Application.ScreenUpdating = True
End Sub