Microsoft 365 atteindre la 1ère date égale ou supérieure à aujourd'hui

[Usine à gaz]

Bonjour à toutes et à tous,
J'espère que vous allez bien

J'ai besoin dans mon fichier d'atteindre la cellule qui contient la 1ère date égale ou supérieure à aujourd’hui.

J'ai fait pas mal de tests sans succès ... bcp de recherches et j'ai trouvé un code sur le forum :

Macro trouvant la date la plus proche

Bonjour les « Forumers » du samedi, Plusieurs posts traitent du pb. mais je n’ai pas trouvé de solution exacte à ce que je cherche, aussi je me permets de vous l’exposer. Soit une plage A1 à A10 qui recense, dans l’ORDRE CHRONOLOGIQUE, une série de jours fériés. Je saisis une date aléatoire...

www.excel-downloads.com

#Post de CBernardT en 2006 que je remercie au passage

J'ai modifié le code pour qu'il corresponde au besoin de mon fichier.
ça fonctionne mais c'est très long et je ne sais pas comment l'améliorer.
J'ai joint un fichier qui contient une douzaine de milliers de lignes .... dans mon fichier de travail c'est 60.000 lignes et +++ et ce serait c'est très très très long
Auriez-vous une solution pour ce que soit plus rapide ?
Avec mes remerciements,
Je vous souhaite une belle journée,
Amicalement,
lionel,

 

[patricktoulon]

re
et oui Dranreb a raison ton T est dimé t() il attend donc un tableau
si zone = 1 cellule son .value donne la valeur si zone = plusieurs cellules son .value te donne un tableau

perso j'aurais dimé T sans parenthèse et variant
et

if zone.cells.count=1 then T =array(zone.value) else T=zone.value

on zappe un redim comme ça

 

[Usine à gaz]

Bonjour Dranreb, Patrick, Le Forum,
Merci pour m'avoir répondu à nouveau
Je vais être indispo aujourd'hui jusqu'à 20 heures.
Je testerai ce soir et je vous dirai
Bonne journée,
lionel,

 

[Usine à gaz]

re-Bonjour Dranreb, Patrick, Le Forum,

J'ai eu un peu de temps pour tester.
Merci Dranreb : super ça fonctionne déjà nickel

Il me reste une question et une demande et ce sera parfait :
Question : Est-ce que le code fonctionne qq soit le format des dates ?
Demande :
Est-il possible, si pas de date supérieure à aujourd'hui dans les lignes affichées, d'atteindre la date plus proche avant aujourd'hui ?
Je joins le fichier test à jour
lionel

 

[Dranreb]

Ça doit être possible sans doute. Mais réfléchi à le le faire toi même, c'est juste le test à changer, celui qui décide si la date Dt examinée est meilleure que la meilleure date retenue jusque là. Et peut être aussi ne faut-il plus initaliser loin dans le futur la meilleure date au départ, s'il faut pouvoir retenir une date passée.

 

[Usine à gaz]

Bonsoir Danreb,
Merci pour m'avoir encore répondu.
Il serait long que j'explique tous les détails de ce dernier besoin :
Cependant, dans le fichier, environ 60.000 lignes et +
Toutes les lignes ont une cellule qui mentionne la date de rappel prévue (colV)
Pour les rappels que nous n'avons pas fait (soit pas eu le temps, ou par manque d'intérêt immédiat),
nous les faisons au besoin et il est important que nous puissions atteindre directement sans chercher dans les 60.000 ligne cette date supérieure la plus proche d'aujourd'hui qui nous amène (au plus vite) aux rappels à faire les plus récents, donc les plus "chauds".
---------------------------------------------------------------------------------------------------------------
"Et peut être aussi ne faut-il plus initialiser loin dans le futur la meilleure date au départ, s'il faut pouvoir retenir une date passée."
- Il est donc important de garder la sélection de la date supérieure la plus proche d'aujourd'hui,
---------------------------------------------------------------------------------------------------------------
- Par contre, à l'inverse et dans le même esprit pour ne pas avoir à chercher dans les 60.000 ligne, si dans le filtrage, il n'y a pas de date supérieure à aujourd'hui, la recherche inverse serait intéressante, c'est à dire trouver la date inférieure à aujourd'hui (-15jrs ou choisir l'éloignement).
---------------------------------------------------------------------------------------------------------------
Merci pour la piste "date Dt", j'ai déjà essayé de trouver sans succès mais je continue à chercher
Bonne nuit,
Amicalement,
lionel,

 

[Dranreb]

Pourrait s'écrire comme ça, entre autre aussi pour éviter le Redim :

Sub Date_Sup()
   Dim Plage As Range, Auj As Date, MeilDate As Date, Zone As Range, T(), L As Long, _
      Dt As Date, MeilCel As Range
   With Sheets("Code_origine")
      Set Plage = .Range(.[J7], .Cells(Rows.Count, "J").End(xlUp))
      End With
   Auj = Date
   For Each Zone In Plage.SpecialCells(xlCellTypeVisible).Areas
      If Zone.Rows.Count = 1 Then
         Dt = Zone.Value: GoSub 1
      Else
         T = Zone.Value
         For L = 1 To UBound(T, 1): Dt = T(L, 1): GoSub 1: Next L: End If: Next Zone
   If Not MeilCel Is Nothing Then Application.Goto MeilCel
   Exit Sub
1: If MeilDate < Auj Then
      If Dt <= MeilDate Then Return
   Else
      If Dt >= MeilDate Then Return
      If Dt < Auj Then Return
      End If
   MeilDate = Dt: Set MeilCel = Zone(L, 1)
   Return

À tester.

 

[Dranreb]

Remarque: Je me demande si c'est bien votre besoin. D'autant plus qu'il serait plus simple de se positionner sur la date la plus proche d'aujourd'hui que ce soit vers le passé ou l'avenir. Par ailleurs il me semble que s'il y a un gros trou entre avant hier et dans deux semaine, c'est avant hier qui a des chances d'être plus important que le plus tôt dans 2 semaines, non ?

 

[Usine à gaz]

Bonjour Dranreb, Patrick, Le Forum,
@ Dranreb :Merci, encore une fois, pour ce code
ça fonctionne en m'envoyant à la dernière ligne du filtrage
Pour remonter à partir de cette dernière ligne du nombre de ligne (aléatoire) voulu ... pas trop compliqué lol.
C'est tout bon et un grand merci pour avoir été là.
Amicalement,
lionel,

 

[Dranreb]

Bonjour.
Oh, je crois que j'ai oublié un : L = 1 avant le 1er : Gosub 1 de sorte qu'il risque d'appliquer un L issu d'une boucle précédente quand il note : Set MeilCel = Zone(L, 1)
À rajouter, donc.

 

[Usine à gaz]

lol : Je vais voir

 

[Usine à gaz]

lol, je suis une vraie bille en vba ... je ne sais même pas où le mettre ce L

 

[Dranreb]

Il faudrait voir à vous améliorer sur ce plan, sinon vous serez toujours dépendant de nous pour les moindres détails. Et moi je marche pas à devoir assumer cette constante assistance.
Je l'ai pourtant dit clairement: il faut le mettre juste devant le 1er GoSub 1 du code indiqué au #21. Et pour mon observation du #22 ?

 

[Usine à gaz]

Je comprends mais c'est trop compliqué pour mes vieux neurones lol
Merci à vous,
lionel,

 

[job75]

Bonjour Lionel et les autres,

Il est rare que j'utilise la méthode Find pour les recherches mais là c'est peut-être jouable :

Sub ChercheDate()
Dim c As Range, dat As Date
On Error Resume Next 'si aucune SpecialCell
With [J:J].SpecialCells(xlCellTypeVisible)
    Set c = .Find(Date, , xlFormulas, xlPart)
    If c Is Nothing Then
        For dat = Int(Application.Min(Date, Application.Max(.Cells))) To Int(Application.Min(.Cells)) Step -1
            Set c = .Find(dat, , , , , xlPrevious)
            If Not c Is Nothing Then
                c.Select 'pour tester
                Exit For
            End If
        Next
    Else
        c.Select 'pour tester
    End If
End With
End Sub

Il n'est pas indispensable que les dates soient triées en colonne J.

A+

 

[Usine à gaz]

Bonjour Gérard,
Merci d'être encore là pour moi
Et merci pour ton code qui fonctionne très bien
Amicalement,
lionel,