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,

 

[Staple1600]

Bonjour le fil, arthour973

arthour973
Je laisse voir ce que tu peux tirer de cet exemple basique

Sub test()
Dim X, XX
[A1:A62].Clear
[A1] = CDate("1-" & Month(Date) - 1)
[A1:A62].DataSeries
X = Application.Match(CDbl(Date), Range("A1:A1600"), 1)
MsgBox X
MsgBox Cells(X, 1)
Rows(X).Delete
XX = Application.VLookup(CDbl(Date + 1), Range("A1:A1600"), 1)
MsgBox Format(XX, "dddd dd mmmm yyyy")
End Sub

 

[Staple1600]

Re

•>arthour973
Sinon, ce serait plus intéressant si tu posais des questions que tu n'as déjà posé jadis...

XL 2010 - Résolu par la communauté bienveillante : atteindre la première cellule = à aujourd'hui

Bonsoir à toutes et à tous, Nouveau souci dans mon fichier. Me re-voilou faisant appel à votre bienveillance :) Le souci je dois appeler des clients à des dates programmées (col Y) Mon besoin est d'atteindre avec un code en Module Standard : 1 - la première cellule égale à aujourd'hui J'ai...

www.excel-downloads.com

PS: Ca doit être le bordel dans tes archives, si tu ne sais pas retrouver tes propres questions...

 

[Usine à gaz]

Bonjour JM,
J'espère que tu vas bien
Merci pôur ton code

J'ai testé et il fonctionne mais je ne pourrai pas l'intégrer dans mon.
Ce serait nickel s'il ne copiait pas de date dans la colonne A et qu'il recherchait dans les cellules de la colonne J tel qu'elles sont formatée
lionel,

 

[Staple1600]

Re

Relire le message#3 et surtout retourner sur le lien qui s'y trouve
(et prendre en urgence des médications pour booster ta mémoire )

 

[Dranreb]

Bonjour.
Vous devriez savoir, depuis le temps, qu'il ne faut jamais travailler directement avec les cellules une par une. Ce ne sont pas, comme le comprennent de travers beaucoup, les boucles simples qui sont pénalisantes, mais le fait d'y travailler directement avec les cellules au lieu d'éléments d'un tableau.
De plus vos dates sont par ordre croissant alors on devrait, comme le propose Staple1600 (en vous disant de seulement vous en inspirer, non de le prendre tel quel) pouvoir se passer de boucle en utilisant Worksheetfunction.Match. Mais j'ai échoué en le tentant, pour une mystérieuse raison ça fait Erreur 1004: Impossible de lire la propriété Match …
Mais comme ça, ça va :

Sub Date_Sup()
   Dim L As Long, Plage As Range
   With Sheets("Code_origine")
      Set Plage = .Range(.[J7], .Cells(Rows.Count, "J").End(xlUp))
      End With
   L = Evaluate("MATCH(TODAY()," & Plage.Address & ")")
   If Plage(L, 1).Value < Date Then L = L + 1
   Application.Goto Plage(L, 1)
   End Sub

 

[Staple1600]

Bonjour Dranreb

Oui, je proposais à arthour973 de s'inspirer du code proposé au message#2 avant de m'apercevoir qu'en 2017, cette même question avait déjà été posée par icelui (et résolue à l'époque)*
Donc je te passe volontiers le relais

*: cf le fil que je cite dans le message#3

 

[Usine à gaz]

Re-JM,
Tu as raison, je l'avais zappé ce fil et Mapomme avait donné une bonne solution.
Je joins le fichier sur le fil avec la solution de Dranreb qui fonctionne nickel aussi.

Bonjour Dranreb : Merci pour vos explications et votre code qui fonctionne parfaitement
lionel,

 

[Usine à gaz]

Re-Bonjour JM, Dranreb,

@JM : Merci à toi d'avoir été ma mémoire (lol, c'est vrai j'en ai besoin en ce moment) ... ça m'a permi d'avancer

@ Dranreb : encore merci pour ton code qui fonctionne parfaitement

Mais ... j'ai omis un point important :
Dans mon fichier de travail selon les actions à mener, je fais des filtrages (tous différents) et j'ai remarqué que la recherche de la 1ère date égale ou supérieure à aujourd'hui se fait dans toutes les lignes y compris celles qui sont masquées.

Serait-il possible de ne pas chercher dans les lignes masquées et d'atteindre la 1ère date égale ou supérieure à aujourd'hui dans les lignes NON masquées ?

Par exemple, dans le fichier test joint, la 1ère cellule trouvée est J12580, j'ai besoin qu'il trouve la cellule J16620

Est-ce que c'est possible ?
Ce serait vraiment super
Lionel,

 

[Dranreb]

Danc ce cas je ferais comme ça :

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

 

[Usine à gaz]

Bonsoir Danreb, le Forum,
Un grand merci pour ce nouveau code.
Je teste dès que j'ai un moment et je reviendrai
lionel,

 

[Usine à gaz]

Re-Bonsoir Danreb,

J'ai testé ton code qui fonctionne super bien dans le fichier test

Mais j'ai un souci quand je l'intègre dans mon fichier de travail ça beug à cet endroit :
For Each Zone In Plage.SpecialCells(xlCellTypeVisible).Areas
T = Zone.Value

Saurais-tu pkoi ça fait ça ?
Je continue à chercher de mon côté,
lionel,

 

[patricktoulon]

re
bonsoir le fil
pour info
match date vba doit chercher un numéro de série sinon c'est l'erreur 1004
evaluate match cherche le string ou la valeur (il choppe les deux)
de plus app.match ne gère par l'erreur en amont evaluate oui

 

[Usine à gaz]

Bonsoir Patrick,
Merci pour ta réponse
mon erreur n'est pas une 1004,
C'est type 13, voir photo :

lionel,

 

[Dranreb]

À la place de T = Zone.Value mettre :

      If Zone.Rows.Count = 1 Then ReDim T(1 To 1, 1 To 1): T(1, 1) = Zone.Value Else T = Zone.Value