Recherche aujourd'hui -ou proche- dans une Bdd

[bond]

Bonjour le forum,
Dans une Base De Données je souhaite placer ma cellule active sur l'enregistrement le plus proche de la date du jour :
Aujourdhui si la date d'aujourdhui est présente, sinon demain si la date de demain est présente, sinon après demain, etc...
Jusqu'à hier ça fonctionnait parfaitement, donc je vous informe du bug du 05/01/2011 puisque aujourdhui vba m'envoit au 05/11/2011 !
Bon, plaisanterie mise à part, je comprends pas où est le pb de mon VBA...
Dans le fichier joint, y'a ce qui fonctionnait hier, et une décomposition suite à mes recherches du matin...

NB : le 05/01/2011 est bien un date présente dans la Bdd
NB : password du fichier : 1234 (si nécessaire)

Merci d'avance de votre aide.

 

[Softmama]

Re : Recherche aujourd'hui -ou proche- dans une Bdd

Bonjour bond,

Cette macro, trouve la date du jour si elle existe ou s'arrête sur la date juste supérieure si la date exacte n'est pas présente.Vois si cela te convient :

Sub test()
    Dim c As Range
    Set c = Columns(1).Find(what:=Int(Now), LookIn:=xlValues, lookat:=xlWhole)
    If c Is Nothing Then 'Si la date du jour n'est pas présente
        Columns(1).Insert: Columns(1).Insert
        Columns(3).Copy Columns(1)
        Columns(1).Sort key1:=[A1], order1:=xlAscending 'On trie les dates
        Set c = [A2]
        Do While c < Int(Now) 
            Set c = c(2, 1)
        Loop  ' on trouve la date juste supérieure à celle du jour
        Set c = Columns(3).Find(what:=c, LookIn:=xlValues, lookat:=xlWhole) 'et on pointe dessus
        Columns(1).Delete: Columns(1).Delete
    End If
    c.Select 'on sélectionne la cellule trouvée
End Sub

 

[bond]

Re : Recherche aujourd'hui -ou proche- dans une Bdd

Merci Softmama,
ça fonctionne impec'
Mais, afin d'insérer ça dans mon application sans pb, y a t-il moyen d'éviter les insertion+copie ? bref, de trouver avec le Find directement la valeur la plus proche...

 

[Softmama]

Re : Recherche aujourd'hui -ou proche- dans une Bdd

ha oui, sans problème,
tu peux tester ainsi :

Sub test()
Dim c As Range, Ecart As Integer
Ecart = 0
Do While c Is Nothing
    Set c = Columns(1).Find(what:=Int(Now) + Ecart, LookIn:=xlValues, lookat:=xlWhole)
    Ecart = IIf(Ecart > 0, -Ecart, -Ecart + 1)
Loop
    c.Select
End Sub

[Edit] Pour info, la macro cherche, la date du jour. Tant qu'elle trouve pas, elle cherche Date du jour +1, puis -1 puis +2, puis -2, puis +3... jusqu'à temps qu'elle trouve.

 

[bond]

Re : Recherche aujourd'hui -ou proche- dans une Bdd

Génial !
Exactement ça, merci du coup de main...
J'ai tout compris, surtout mon erreur de raisonnement + arguments de Find.

@+