Fichier Excel : Retenir les dates les plus récentes par millésimes

[nahtalie]

Hello,

Catrice un nouveau défi pour toi (et pour les autres aussi).

J'ai un tableau Excel avec plusieurs dates d'arrêté comptable pour des années différentes et pour chaque année je souhaite retenir la date la plus récente (ne garder que ces lignes là) automatiquement, sans avoir a y revenir dessus à chaque fin de trimestre (pas de manuel).

par exemple :

Dates d'arrêtés
31/03/2006
30/06/2006
30/09/2006
31/12/2006 (on garde que cette ligne pour 2006)
31/03/2007
30/06/2007
30/09/2007
31/12/2007 (on garde que cette ligne pour 2007)
31/03/2008
30/06/2008
30/09/2008
31/12/2008 (on garde que cette ligne pour 2008)
31/03/2009 (on garde que cette ligne pour 2009)

par contre à fin juin j'aurais :

31/03/2009
30/06/2009 (et je ne garderais que celle là)
etc...

Voila j'espère que je suis claire,
sinon j'envoie le fichier.


D'avance un grand merci pour votre aide,
++
nat🙂


ps : zetes les meilleurs!

 

[nahtalie]

Re : Fichier Excel : Retenir les dates les plus récentes par millésimes

mince j'ai oublié le fichier, chui allée encore trop vite, bon sang lol!😛


(c) CJoint.com, 2008

 

[Catrice]

Re : Fichier Excel : Retenir les dates les plus récentes par millésimes

Re,

Voici les dates que je récupère avec ton fichier et mon code :

31/12/1998
31/12/1999
31/12/2000
31/12/2001
31/12/2002
31/12/2003
31/12/2004
31/12/2005
31/12/2006
31/12/2007
31/12/2008
31/03/2009

Tu veux récupérer quoi exactement ?

 

[nahtalie]

Re : Fichier Excel : Retenir les dates les plus récentes par millésimes

bah comme toi, mais pourquoi ça n'a pas marché chez moi ?

je comprends pas là.

nat🙂

 

[Catrice]

Re : Fichier Excel : Retenir les dates les plus récentes par millésimes

Il faut que la colonne K soit triée.

Modifie le code comme ceci :


With ActiveSheet
.Range(MaCol & "3").Sort Key1:=.Range(MaCol & "3"), Header:=xlYes
For Each X In .Range(MaCol & "3:" & .Range(MaCol & "65536").End(xlUp).Address)

 

[nahtalie]

Re : Fichier Excel : Retenir les dates les plus récentes par millésimes

Ok merci.

Je m'y remets demain au taf et je te dis.

Bonne soirée,
++
nat🙂

 

[nahtalie]

Re : Fichier Excel : Retenir les dates les plus récentes par millésimes

Hello Catrice,
Hello tout le monde,


J'ai relancé la macro et ce n'est pas encore tout à fait ça qu'il me faut :

il faut garder toutes les lignes au 31/12/1998, 31/12/1999, etc...

Désolée je n'ai pas été claire.

Voici ce que j'aimerais :
31/12/1998
31/12/1998
31/12/1998
31/12/1998
31/12/1998
31/12/1998
etc...
31/12/1999
31/12/1999
31/12/1999
31/12/1999
31/12/1999
31/12/1999
31/12/1999
etc...
31/12/2000
31/12/2000
31/12/2000
etc
31/12/2001
31/12/2001
31/12/2001

...

31/03/2009
31/03/2009
31/03/2009
31/03/2009

etc...


nat😕

 

[pierrejean]

Re : Fichier Excel : Retenir les dates les plus récentes par millésimes

Re

Version avec conservation de toutes les lignes ayant la derniere date d'arrêté (et il y en a !!!!)
Chez moi en 25 secondes
Si necessaire je peux essayer d'accelerer

Sub essai()
Application.ScreenUpdating = False
Dim tablign()
Dim coll As Collection
Set coll = New Collection
For n = 1 To Range("K65536").End(xlUp).Row
   If IsDate(Range("K" & n)) Then
     On Error Resume Next
       coll.Add Year(Range("K" & n)), CStr(Year(Range("K" & n)))
     On Error GoTo 0
   End If
Next n
ReDim tablign(1 To coll.Count)
For n = 1 To coll.Count
  For m = 1 To Range("K65536").End(xlUp).Row
    If IsDate(Range("K" & m)) Then
     If Year(Range("K" & m)) = coll(n) And tablign(n) < Range("K" & m) Then
      tablign(n) = Range("K" & m)
     End If
    End If
  Next m
Next n
For n = 1 To coll.Count
 For m = Range("K65536").End(xlUp).Row To 3 Step -1
   If Year(Range("K" & m)) = Year(tablign(n)) And Range("K" & m) <> tablign(n) Then Rows(m).Delete
 Next m
Next n
[COLOR=blue]Range("A3:O" & Range("A65536").End(xlUp).Row).Sort Key1:=Range("K3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom[/COLOR]
Application.ScreenUpdating = True
End Sub

 

[Catrice]

Re : Fichier Excel : Retenir les dates les plus récentes par millésimes

Bonjour à tous,

Je ne sais pas si j'adresse tous les cas de figures de ton fichier mais le code suivant garde tous les 31/12/xxxx et la derniere date en cours.
Malgré un traitement un peu lourd, ça met 9s.


Sub test()
Application.ScreenUpdating = False
MaCol = "K"
With ActiveSheet
.Range(MaCol & "3").Sort Key1:=.Range(MaCol & "3"), Header:=xlYes
MaVar = .Range(MaCol & "65536").End(xlUp)
For i = .Range(MaCol & "65536").End(xlUp).Row To 3 Step -1
If .Range(MaCol & i) <> DateSerial(Year(.Range(MaCol & i)), 12, 31) And .Range(MaCol & i) <> MaVar Then .Range(MaCol & i).EntireRow.Delete
Next
End With
Application.ScreenUpdating = True
End Sub

 

[Fo_rum]

Re : Fichier Excel : Retenir les dates les plus récentes par millésimes

Salut

autre proposition :

Option Explicit
Private Sub CommandButton1_Click()
  Dim Tablo(), Tableau() [COLOR=SeaGreen]'colonne K, contenus retenus[/COLOR]
  Dim Derli As Long, X As Long, N As Long, I As Integer, Li As Long, L As Long

  Derli = [K65536].End(xlUp).Row
  Range("A3:O" & Derli).Sort Key1:=Range("K3"), Order1:=xlAscending
  Application.DisplayAlerts = False
 [COLOR=SeaGreen] 'Ajout d'une feuille "Base" copie de la première[/COLOR]
  ActiveSheet.Copy after:=ActiveSheet
  ActiveSheet.Name = "Base"
[COLOR=SeaGreen] 'construction du tableau des lignes gardées jusqu'à l'avant-dernière année[/COLOR]
 ReDim Tablo(Derli + 1)
  For N = 0 To Derli
    Tablo(N) = Cells(N + 3, "K")
    Tablo(N + 1) = Cells(N + 4, "K")
    If Year(Tablo(N + 1)) > Year(Tablo(N)) Then
      I = I + 1
      ReDim Preserve Tableau(I)
      Tableau(I) = Tablo(N)
      Li = N
    End If
  Next
 [COLOR=SeaGreen] 'ajout feuille temporaire pour les lignes gardées[/COLOR]
  ActiveSheet.Copy after:=ActiveSheet
  ActiveSheet.Name = "TMP"
  ActiveSheet.Range("A3:O" & Derli).ClearContents
  Sheets("Base_sinistres").Select
  'ajout des lignes de la dernière année
  L = 2
  For N = 3 To Derli
    For X = 1 To I
      If Cells(N, "K") = Tableau(X) Then
        L = L + 1
        Range("A" & N & ":O" & N).Copy Sheets("TMP").Range("A" & L)
        Exit For
      End If
    Next
  Next
  Sheets("Base").Range("A" & Li & ":O" & Derli).Copy Sheets("TMP").Range("A" & L + 1)
 [COLOR=SeaGreen] 'suppression feuilles temporaires[/COLOR]
  ActiveSheet.Delete
  Sheets("Base").Delete
  Sheets("TMP").Select
  ActiveSheet.Name = "Base_sinistres"
End Sub

à tester sur un gros fichier.

Catrice , as-tu une Formule 1 pour ne le faire qu'en 9s ?
Avec le fichier Cjoint, ta dernière macro et ma machine, je suis très loin du compte !

 

[nahtalie]

Re : Fichier Excel : Retenir les dates les plus récentes par millésimes

Tip top, Pierre Jean ça marche nickel chrome.
1000 fois merci.

Par contre ça à mis 10 mm à tourner chez moi, si on peut réduire ?

Et aussi si possible, dans la colonne "entité" j'ai plusieurs entités différente S01, S02 ... S09,

je souhaiterais faire "pêter" la S09, (en fait j'ai besoin de toutes les entités sauf la S09) déjà ça pourra réduire un peu le temps de la macro.


++
nat🙂

 

[nahtalie]

Re : Fichier Excel : Retenir les dates les plus récentes par millésimes

Catrice, Pierre Jean

Si vous avez une idée pour réduire le délai d'exécution de la macro + virer l'entité S09 (virer toutes les lignes appartenant à l'entité S09).


D'avance merci pour votre aide précieuse,
++
nat🙂

 

[Fo_rum]

Re : Fichier Excel : Retenir les dates les plus récentes par millésimes

Re,

Même si ma macro ne convient pas, tu aurais pu au moins me le signaler 😡 !
Si tu persévères dans cette attitude, tu risques de te fermer des portes.
Tableau Excel : retenir la date la plus récente dans l'année - Forum des développeurs

 

[nahtalie]

Re : Fichier Excel : Retenir les dates les plus récentes par millésimes

Toutes mes excuses Fo_rum,

Merci pour ta macro, il est vrai que je n'ai pas répondu et que je n'ai pas eu le temps d'y répondre.

J'espère que tu verras ainsi ta sensibilité ménagée.


++
nat🙂

 

[Catrice]

Re : Fichier Excel : Retenir les dates les plus récentes par millésimes

@ Fo_rum
J'ai testé ton code sur ma machine => 23 s et derniere ligne = 2453
Le mien => 1:06 et derniere ligne = 2449

J'ai enlevé les 1900 de la colonne L et refait le test.
Ton code => 15 s
Le mien => 10 s !?
Pierrejean => 41 s et derniere ligne 2449 (avec les lignes 1900 j'avais un pb. donc testé que dans cette configuration)

J'avais du faire le test dans cette configuration.
en tous cas ça vaut le coup de supprimer ces dates 😉

Il y a 4 lignes de différences à checker ...

@nathalie
Pourras tu dire si finalement tu as obtenu ce que tu voulais ?

 

[Fo_rum]

Re : Fichier Excel : Retenir les dates les plus récentes par millésimes

Re,

...
J'espère que tu verras ainsi ta sensibilité ménagée.

Ce ne sont pas mes états d'âme que j'expose ! Mais quand bien même !
Le nombre de demandeurs mal-polis, exigeants, ..., indélicats est en progression constante donc mes interventions sont inversement proportionnelles à celui-ci !
Je ne change pas un mot de mon message précédent d'autant plus tu fais partie de ceux qui multiplient les changements au fil des fils !