Extraire des dates d'une base vba excel

Bonjour,

Je cherche un bout de code en vba sous Excel
Je cherche à extraire des dates d'une colonne en "filtrant" sur une date de début et une date de fin.
Ce résultat s'afficherait dans une listbox.
Merci de votre aide !

Real-6

5 réponses

  1. Modérateur
    Salut,
    Cela provient, j'en suis sur à 90%, d'un problème de format.
    Si, dans tes cellules, tu as des dates au format "Date", il faut les comparer avec les valeurs contenues dans ton textbox, converties au format "Date". En effet, les valeurs retournées par un textbox sont au format "String" (chaine de caractère). Et donc si tu les compare à des dates, Excel ne peux pas filtrer...
    regarde déjà de ce côté...
    1. Modérateur
      Salut,
      ça fonctionne avec :
      Critere7 = "*"
           If IsDate(TextBoxDateDebut) Then Critere7 = CDate(TextBoxDateDebut)

      et le test dans ta boucle :
      If Range("G" & lgLigDeb).Value Like Critere1 And Range("H" & lgLigDeb).Value Like Critere2 And Range("C" & lgLigDeb).Value Like Critere3 And Range("D" & lgLigDeb).Value Like Critere4 And Range("E" & lgLigDeb).Value Like Critere5 And Range("I" & lgLigDeb).Value Like Critere6 And Range("F" & lgLigDeb).Value >= Critere7 Then


      En fait tu cherchais avec Like... C'est tout à fait ce que je te disais. Ici tu cherches les dates > ou = à celle saisie. N'utilises pas Like, mais >=!!!
      Allons...
      ton fichier corrigé
      1. Salut,
        Désolé j'ai regardé tardivement tes corrections donc voilà,
        j'ai testé le fichier mais ça ne marche pas !?!
        Quand je change la valeur de TextBoxDateDebut, par par exemple 01/02/2012, le filtre ne fonctionne pas...
        je ne vois plus quoi faire...
        si tu as une autre idée, je suis preneur...
        Merci
    2. Modérateur
      Salut,
      Si tu as besoin je peux envoyer le fichier.
      Ben je veux bien parce que là je capte pas trop ou tu veux en venir...
      Va sur https://www.cjoint.com/ créer un lien vers ton fichier, copie ce lien et reviens nous le coller ici.
      1. Ok, donc voilà le lien du fichier à télécharger :

        http://cjoint.com/?3CouS3MXefa

        Vous m'excuserez mais le fichier est encore en chantier...

        Merci pour l'intêret porté !
      2. Je veux me servir de ce fichier comme un outil de gestion de maintenance :
        Traçabilité des demandes, recherche des demandes par criteres, suivi des actions correctives, création d'ordre de travail...
        la partie traitée est la traçabilité et le suivi des demandes est quasi terminé (me reste à filtrer les demandes sur un intervalle de temps)
        Le reste je traiterai plus tard !
    3. Modérateur
      Bonjour,

      Remplace déjà :
      If CheckBox1 = True Then Critere6 = "Urgent" 
      If CheckBox1 = False Then Critere6 = "*" 
      
      Critere7 = "*" 
      'ici manque le code dont j'ai besoin 
      
      ListBoxLocataire.Clear 


      Par :
      If CheckBox1 = True Then Critere6 = "Urgent" Else Critere6 = "*" 
      
      Critere7 = "*" 
      If IsDate(TextBoxDateDebut) Then 
          Critere7 = CDate(TextBoxDateDebut)
      Else
          MsgBox "Saisie de la date de début obligatoire"
          Exit Sub
      End If 
      
      ListBoxLocataire.Clear 


      Après, regarde s'il vaut mieux utiliser like ou = pour la comparaison de tes critères avec les cellules...
      1. Ok merci, ça marche pour le Critere6
        par contre, pour le Critere7 ça ne marche pas, je pense qu'il faudrait un code plutôt dans ce style (j'arrive pas à le traduire):

        Si les dates de la colonne F >= TextBoxDateDebut et si les dates de la colonne F <= TextBoxDateFin alors Critere7 = les dates trouvées de la colonne F

        De plus, Je n'arrive pas à avoir une valeur pour CDate(TextBoxDateFin) que j'ai défini dans l'initialisation du UserForm par TextBoxDateFin.Text = Date

        Je galère trop !!!!

        Si tu as besoin je peux envoyer le fichier.
        Encore merci pour tes efforts !
    4. Modérateur
      Bonjour,
      Par exemple, si tes dates sont en colonne A Feuil1 :
      Dim Lig As Long, DrLig As Long
      DrLig = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
      For Lig = 1 To DrLig
          If CDate(Sheets("Feuil1").Range("A" & Lig).Value) > DateSerial(2012, 2, 12) And CDate(Sheets("Feuil1").Range("A" & Lig).Value) < DateSerial(2012, 3, 12) Then
              ListBox1.AddItem Sheets("Feuil1").Range("A" & Lig).Value
          End If
      Next


      Pour info : DateSerial(2012, 2, 12) = 12 février 2012
      1. Merci pour ta réponse !
        j'ai essayé ton code en l'adaptant mais ça ne marche pas
        Je n'ai pas précisé certain point comme les dates de début et de fin sont dans des TextBox avec des valeurs par défaut :
        TextBoxDateDebut.Text = "01/01/2012"
        TextBoxDateFin.Text = Date

        MON CODE :

        Private Sub Rechercher()
        Worksheets("BDD").Activate
        ' Rechercher les données en fonction des critères de recherche

        Dim lgLigDeb As Long
        Dim Critere1 As String
        Dim Critere2 As String
        Dim Critere3 As String
        Dim Critere4 As String
        Dim Critere5 As String
        Dim Critere6 As String
        Dim Critere7 As String 'Critere pour filtrer sur les dates

        Critere1 = "*"
        If ComboBoxCivil.Value <> "" Then Critere1 = ComboBoxCivil.Value

        Critere2 = "*"
        If ComboBoxNom.Value <> "" Then Critere2 = ComboBoxNom.Value

        Critere3 = "*"
        If ComboBoxCommunes.Value <> "" Then Critere3 = ComboBoxCommunes.Value

        Critere4 = "*"
        If ComboBoxLieu.Value <> "" Then Critere4 = ComboBoxLieu.Value

        Critere5 = "*"
        If ComboBoxLocal.Value <> "" Then Critere5 = ComboBoxLocal.Value

        If CheckBox1 = True Then Critere6 = "Urgent"
        If CheckBox1 = False Then Critere6 = "*"

        Critere7 = "*"
        'ici manque le code dont j'ai besoin

        ListBoxLocataire.Clear

        ' Boucle de la 2me à la dernière ligne de la feuille BDD
        For lgLigDeb = 2 To Range("A" & Cells.Rows.Count).End(xlUp).Row
        If Range("G" & lgLigDeb).Value Like Critere1 And Range("H" & lgLigDeb).Value Like Critere2 And Range("C" & lgLigDeb).Value Like Critere3 And Range("D" & lgLigDeb).Value Like Critere4 And Range("E" & lgLigDeb).Value Like Critere5 And Range("I" & lgLigDeb).Value Like Critere6 And Range("F" & lgLigDeb).Value Like Critere7 Then
        With ListBoxLocataire
        .AddItem Range("A" & lgLigDeb).Value
        .List(.ListCount - 1, 1) = Range("B" & lgLigDeb).Value
        .List(.ListCount - 1, 2) = Range("C" & lgLigDeb).Value
        .List(.ListCount - 1, 3) = Range("D" & lgLigDeb).Value
        .List(.ListCount - 1, 4) = Range("E" & lgLigDeb).Value
        .List(.ListCount - 1, 5) = Range("F" & lgLigDeb).Value
        .List(.ListCount - 1, 6) = Range("G" & lgLigDeb).Value
        .List(.ListCount - 1, 7) = Range("H" & lgLigDeb).Value
        .List(.ListCount - 1, 8) = Range("I" & lgLigDeb).Value
        .List(.ListCount - 1, 9) = lgLigDeb

        End With
        End If

        Next lgLigDeb

        End Sub

        Si tu peux m''aider avec ça ...

        Merci d'avance !