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

[Usine à gaz]

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 bien sûr fait des recherches sur le forum et chez google.
Je n'ai pas trouvé.
J'ai tenté (find) mais je n'y arrive pas.

Dans l'espoir que vous pourrez m'aider, je joins un fichier test.
Je vous remercie déjà de m'avoir lu.
Amicalement,
Lionel,

 

[Usine à gaz]

J'ai testé .... mais changer le format date en anglais me pose un pbl.
Nous sommes 4 à travailler avec notre classeur et habitué au format jj mm aa pour tous nos classeurs de travail.
J'ai quand même essayé avec le code Range("B1") = Format(Date, "ddd dd mm yy").
Mais ça me transforme toutes les dates en 02/01/2017.
Encore merci pour cet essai car le formatage couleur me sera utile.
Amicalement,
Lionel,

 

[Usine à gaz]

Bonjour à toutes et à tous,
et plus particulièrement à :
JCGL, Kris5, Kim75, LoneWolf et .... la personne qui m'a donné le lien Lien supprimé
Je vous remercie encore tous de m'avoir répondu et fourni des codes qui fonctionnent.

Je me permet de relancer ce fil car j'ai quelques soucis d'utilisation :
Le code de Chris :
Ne renvoie pas à aujourd'hui ligne 2 mais renvie au 3/12/2017 ligne 305
Le code de Kim75
Ne renvoie qu'une fois à aujourd'hui

Le code de JCGL
Fonctionne très bien mais beugue si aujourd'hui n'existe pas
Le code de LoneWolf
Fonctionne très bien mais beugue si aujourd'hui n'existe pas
Le lien Aller à aujourd'hui
Fonctionne très bien mais #N/A si aujourd'hui n'existe pas

Je pense qu'il est normal que les codes beuguent si aujourd'hui n'existe pas.
Je ne l'avais pas prévu dans ma question.

Je n'avais pas prévu qu'aujourd'hui pouvait ne pas être dans la liste des dates
Est-il possible que si aujourd'hui n'existe pas, la cellule qui contient la date la plus proche soit atteinte ?

J'ai tenté de rechercher et de modifier mais je n'y arrive pas.
Si vous aviez la solution, ça m'arrangerait bien LOL
Encore un grand merci pour votre gentillesse.
Je joins le classeur dans lequel j'ai inclus vos codes.
Avec mes remerciements, je vous souhaite une bonne journée,
Amicalement,
Lionel,

 

[Lone-wolf]

Bonjour Lionel

Il faut ajouter dans ce cas la condition:

If IsEmpty(c) Then
Exit Sub
Else
La macro
End If

 

[Usine à gaz]

Bonjour Lone,

Merci d'être encore là

Je teste et je te dis.
Bonne journée,

 

[Lone-wolf]

Re Lionel

Sinon comme ceci c'est ok, j'ai modifié la macro

Option Explicit

Sub atteindre()
Dim plage As Range, cel As Range, c As Range, dt As Date

  Application.ScreenUpdating = False

  With Feuil1
  Set plage = .Range("b2:b" & Range("b" & Rows.Count).End(xlUp).Row)
  For Each cel In plage

  If cel = Date Then
  cel.Activate
  cel.Interior.Color = vbRed
  cel.Font.Color = vbWhite
  cel.Offset(1, 0).Interior.Color = xlNone
  cel.Offset(1, 0).Font.Color = vbBlack
  End If
  dt = DateDiff("d", Date, .Range("e2").Value)
  If dt > 1 And cel.Value = Date Then
  cel.Offset(1, 0).Activate
  cel.Offset(0, 0).Interior.Color = xlNone
  cel.Offset(0, 0).Font.Color = vbBlack
  cel.Offset(1, 0).Interior.Color = vbRed
  cel.Offset(1, 0).Font.Color = vbWhite
  End If
  Next cel
  End With
End Sub

 

[Usine à gaz]

Merci Lone,
Ton code fonctionne bien mais, s'il n'y a pas de date "aujourd'hui', je voudrais atteindre la date la plus proche.
Lionel,

 

[Si...]

Salut

à voir (après adaptation)

Dim l As Long, n As Byte
Sub Bouton2Cliquer()
    If [B:B].Find(Date) Is Nothing Then
        l = 4                       'à ajuster
        For n = 1 To 31    'à ajuster
            Do
                l = l + 1
            Loop Until Cells(l, 1) = Date - n Or l < 41  'à ajuster
        Next
        Cells(l - 1, 2).Select
    Else
        Application.Goto [B:B].Find(Date)
    End If
End Sub

nota : changer le sens pour avoir la plus proche inférieure

 

[Lone-wolf]

Regarde le fichier joint, si ça joue

Mais avant ajoute le mois de janvier, sinon ça fait bizarre

 

[Usine à gaz]

Bonjour si, merci d'être là,
Re Lone,

Pour Si :
Votre code Fonctionne très bien mais renvoie à la ligne 34 si aujourd'hui n'existe pas et ne va pas à la date la plus proche.

Pour Lone : ça marche plus (je n'ai pas besoin de msgbox ni de couleur ).

Je remets le fichier avec les codes à jour.
Merci vraiment à vous,
Amicalement,
Lionel,

 

[Lone-wolf]

Re Lionel

Si tu raccourci encore la colonne des dates, c'est sûr que le curseur vas arriver sur la date la plus proche (c'est à dire AUHOURD'HUI) LOL

 

[Usine à gaz]

LOL, c'est un exemple .... j'ai raccourci pour l'exemple. mais cela ne devrait pas avoir d'incidence sur le fonctionnement du code.
Mais pour info, quand j'ai testé, j'avais laissé toutes les lignes.

 

[mapomme]

Bonjour à tous,

Un essai avec une méthode basée sur un tableau de value2. Notez que la date la plus proche peut être soit antérieure soit postérieure à la date du jour.

Sub trouver_aujourdhui()
Dim tablo, auj&, ecart, ligEcart&, i&

   tablo = Range(Cells(3, "b"), Cells(Rows.Count, "b").End(xlUp)).Value2
   auj = Date: ecart = 1000000000#: ligEcart = 1
   For i = 1 To UBound(tablo)
      If IsNumeric(tablo(i, 1)) Then
         If tablo(i, 1) > 0 Then
            If Abs(tablo(i, 1) - auj) < ecart Then
               ligEcart = i
               ecart = Abs(tablo(i, 1) - auj)
            End If
         End If
      End If
   Next i
   Application.Goto Cells(ligEcart + 2, "b")
End Sub

edit : v1a

 

[Lone-wolf]

Re Lionel

Voici un nouveau fichier pour test. Le seul petit problème, c'est qu'il faut activer la cellule du jour. Pour tester, change la valeur en E2. Là il faut activer la cellule du jour, puis cliquer sur le bouton.

 

[Usine à gaz]

Bonsoir Mapomme,
Merci aussi d'être là,

Votre code fonctionne très bien. Un grand merci à vous.
Est-il possible que la date atteinte soit toujours supérieure ?

Lone, ton code fonctionne aussi en activant effectivement la cellule du jour.

Vraiment merci pour tant d'écoute.
Amicalement,
Lionel,

 

[Lone-wolf]

En ce qui concerne ma macro, oui.

ActiveCell.Offset(-1, 0) à changer par ActiveCell.Offset(1, 0). Mais dans ce cas ce n'est plus la date la plus proche.