VBA Recherche date

Bonjour à tous,

Mon problème est le suivant :

J'ai actuellement en A1 une date de début et en A2 une date de fin (soit A1<A2).

Dans ma colonne B j'ai tout une série de dates allant de B1 à B10 et je souhaiterai afficher en C1 le résultat de la recherche suivante:

Je veux rechercher la première date (présente dans la colonne B), comprise dans l'intervalle [A1:A2]. Autrement dit, je veux qu'en C1 s'affiche la première date qui vient juste après celle marquée dans la cellule A1 mais qui soit dans l'intervalle de date A1 et A2.

J'espère avoir été assez clair, ce n'est pas simple à expliquer...

Merci d'avance pour votre aide car je coince totalement.

Cordialement,

Corsaire

Bonjour,

solution vba

Sub rechdate()
    mindate =1E9
    For Each c In Range("B1:B10")
        If c > Range("A1") And c < Range("A2") And c < mindate Then mindate = c
    Next c
    Range("C1") = mindate
End Sub

Bonsoir h2so4,

Merci pour ta réponse c'est parfait.

Petite question pour terminer, sais-tu comment on pourrai faire pour avoir la seconde date min et non la première min ?

Cordialement,

Corsaire.

bonjour,

macro et logique adaptée

Sub rechdate()
Dim p As Range
    For Each c In Range("B1:B10")
        If c > Range("A1") And c < Range("A2") Then If p Is Nothing Then Set p = c Else Set p = Union(p, c)
    Next c
    If p Is Nothing Then Range("C1") = "non trouvé" Else Range("C1") = Application.WorksheetFunction.Small(p, 2)
End Sub

Bonjour,

Bonjour h2so4,

Respect

Cdlt.

Bonjour,

Merci et chapeau car ton code est condensé et très propre !

Corsaire

Bonsoir H2SO4,

Désolé de te déranger de nouveau mais j'aurai une petite modification à apporter à ton super code que tu m'as déjà donné. Je souhaiterai pouvoir rechercher la date min de la colonne B et la copier dans la cellule D1. Jusque là pas de problème grâce à ton code.

Cependant, je souhaiterai également copier la valeur de la cellule en face de la date min. Dans mon fichier exemple, je souhaiterai que la macro voit que c'est bien en B1 que la date est la plus petite et qu'elle recopie les valeurs de B1 et C1 en D1 et E1.

Si je ne suis pas assez clair dit le moi... Merci pour ton aide précieuse !

Cordialement,

Corsaire.

FICHIERS JOINTS

test.xlsm

(15.5 Kio) Pas encore téléchargé

corsaiire

Membre habitué

bonsoir,

proposition de modification du code.

Sub rechdate()
    Dim p As Range
    For Each c In Range("B1:B10")
        If c > Range("A1") And c < Range("A2") Then If p Is Nothing Then Set p = c Else Set p = Union(p, c)
    Next c
    If p Is Nothing Then
        Range("D1") = "non trouvé"
    Else
        Range("D1") = Application.WorksheetFunction.Small(p, 1)
        Range("E1") = Application.WorksheetFunction.VLookup(Range("D1"), Range("B1:C10"), 2, False)
    End If
End Sub

Bonsoir H2SO4.

Désolé de ce retard, j'avais pris quelques jours de congés.

Merci pour ton code, cela semble fonctionner, sauf quand je l'adapte à mon classeur.

En effet j'ai le message d'erreur : "Erreur 1004, impossible de lire la propriété small de la classe WorksheetFunction".

Voici le code que j'ai :

Public Sub Écriture()

    For Each c In Range("B7:B27")
        If c >= Range("A1") And c <= Range("A2") Then If p Is Nothing Then Set p = c Else Set p = Union(p, c)
    Next c
    If p Is Nothing Then
        Sheets("FL").Range("K23") = ""
    Else
        ThisWorkbook.Worksheets("FL").Range("K23") = Application.WorksheetFunction.Small(p, 1)
        ThisWorkbook.Worksheets("FL").Range("N23") = Application.WorksheetFunction.VLookup(ThisWorkbook.Worksheets("FL").Range("K23"), Range("B7:C27"), 2, False)
    End If

End Sub

D'où vient mon erreur ? je ne vois pas ...

Cordialement,

Corsaire.

le problème doit venir des données. peux-tu mettre ton fichier ?

sinon essaie ce code et reviens avec le résultat du msgbox

Public Sub Écriture()

    For Each c In Range("B7:B27")
        If c >= Range("A1") And c <= Range("A2") Then If p Is Nothing Then Set p = c Else Set p = Union(p, c)
    Next c
    If p Is Nothing Then
        Sheets("FL").Range("K23") = ""
    Else
        msgbox p.address
        ThisWorkbook.Worksheets("FL").Range("K23") = Application.WorksheetFunction.Small(p, 1)
        ThisWorkbook.Worksheets("FL").Range("N23") = Application.WorksheetFunction.VLookup(ThisWorkbook.Worksheets("FL").Range("K23"), Range("B7:C27"), 2, False)
    End If

End Sub

Je viens de comprendre grâce à ta msgbox que le problème venait du fait que certaines cellules de la plage B7:B27 étaient vides et faisait planter la macro. Donc ça c'est résolu.

Je te met le fichier ci-joint quand même car le problème qui se pose maintenant c'est que la macro n'arrive pas à trouver la datemin, il y à toujours "non trouvée" d'affiché en K23... As-tu la solution ?

Cordialement,

Corsaire.

6test.xlsm (22.30 Ko)

Bonjour,

le problème vient du fait que tes infos en E3 et F3 ne sont pas des dates (au format date)

sinon proposition de correction de ton code (erreur dans l'adressage de la plage dans vlookup)

Public Sub Écriture()
    Set ws1 = ThisWorkbook.Worksheets("Temporaire")
    Set ws2 = ThisWorkbook.Worksheets("Feuil1")
    For Each c In ws1.Range("B7:B9")
        If c > ws1.Range("E3") And c < ws1.Range("F3") Then If p Is Nothing Then Set p = c Else Set p = Union(p, c)
    Next c
    If p Is Nothing Then
        ws2.Range("K23") = "non trouvée"
    Else
        ws2.Range("K23") = Application.WorksheetFunction.Small(p, 1)
        ws2.Range("N23") = Application.WorksheetFunction.VLookup(ws2.Range("K23"), ws1.Range("B7:C9"), 2, False)
    End If
End Sub

Ok compris. Mais quand je passe par un Userform, impossible de le faire prendre un format date reconnu, donc ça me génère le même problème... Si je tape la date à la main dans E3 et F3 aucun problème la macro fonctionne, mais en passant par le formulaire je n'y arrive pas... (merci pour ta correction)

6test.xlsm (25.22 Ko)
corsaiire a écrit :

Ok compris. Mais quand je passe par un Userform, impossible de le faire prendre un format date reconnu, donc ça me génère le même problème...

bonjour,

utilise l'instruction range("E3")=cdate(ton_textbox) pour convertir ta date du userform en date au format excel..

Je n'avais pas pensé à cette possibilité, super !

Bon par contre j'ai un nouveau problème, c'est que la fonction vlookup que tu m'as fait découvrir avec ton code ne marche pas pour les dates... Pour n'importe quelle autre valeur, la fonction arrive à récupérer le contenu de la cellule mais si c'est une date, ça ne marche pas...

J'en finirai jamais... Merci pour ta patience en tout cas H2SO4 !

16test.xlsm (26.17 Ko)

Je n'ai rien dit, tout marche à merveille, j'ai du faire une fausse manip' ...

Encore merci pour tout H2SO4 !

Bonne soirée à toi.

Cordialement,

Corsaire.

Rechercher des sujets similaires à "vba recherche date"