Recherche entre 2 Dates

Bonjour,

Sur mon fichier ci-joint j'aimerais qu'un trie soit fait par rapport a 2 dates

- Userform_Acceuil --> Bouton Rechercher "CommandButton_Rechercher" j'aimerais que l'on puisse extraire les données par rapport au 2 dates des DatePiker, Données du tableau Sheet PPCM extraire sur Sheet Recherche.

Pouvez-vous m'aidez

PS: un calendrier c'est glisser sur la feuille PPCM si vous arrivais a l'enlever car moi je n'y arrive pas.

Merci d'avance de votre aide

Bonsoir brutus01, le forum,

Un essai.....je maitrise peu les listobjects,

Private Sub CommandButton_Rechercher_Click()
 Dim VdateDebut, VdateFin                                'déclaration des variables

 On Error Resume Next                                    'si une erreur est générée, on passe à l'étape suivante
 Sheets("Recherche").ListObjects("TB_13").DataBodyRange.ClearContents  'on efface le tableau TB_13

  With Worksheets("PPCM")
    If .FilterMode Then .ShowAllData                       'on enlève le filtre si il est actif
     VdateDebut = Format(CDate(DTPicker1), "mm/dd/yyyy")   'définit la date de départ
        VdateFin = Format(CDate(DTPicker2), "mm/dd/yyyy")  'définit la date de fin
    With .ListObjects("TB_1").Range
        .AutoFilter 2, ">=" & VdateDebut, xlAnd, "<=" & VdateFin  'filtre sur la colonne 2 du tableau TB_1
        .SpecialCells(xlVisible).Copy                             'copie les cellules visibles
         Sheets("Recherche").ListObjects("TB_13").DataBodyRange(1, 1).PasteSpecial Paste:=xlPasteValues  'colle les données dans le tableau TB_13
         Sheets("Recherche").ListObjects("TB_13").ListRows(1).Delete  'J'efface la première ligne car titre en doublons
        .AutoFilter Field:=2                                          'enlève le filtre
    End With
  End With
  Application.CutCopyMode = False                                     'déselectionne les lignes copiées
End Sub

Cordialement,

Salut xorsankukai

Merci pour ton retour, ça ne fonctionne pas chez moi.

J'ai pas pu mettre de DatePicker car pas dispo sur ma version j'ai mis des Zone texte a la place.

j'ai remis le fichier avec la version final, peux tu essayer ?

Re,

Merci pour ton retour,

Nouvel essai avec Textbox....

Private Sub TextBox1_Change()
 'Code permettant de mettre une date au format 00/00/0000 dans une textbox
Dim valeur As Byte
 TextBox1.MaxLength = 10 'nb caractères maxi autorisé dans le textbox
             valeur = Len(TextBox1)
          If valeur = 2 Or _
             valeur = 5 Then TextBox1 = TextBox1 & "/"

End Sub

Private Sub TextBox2_Change()
  'Code permettant de mettre une date au format 00/00/0000 dans une textbox
Dim valeur As Byte
 TextBox2.MaxLength = 10 'nb caractères maxi autorisé dans le textbox
             valeur = Len(TextBox2)
          If valeur = 2 Or _
             valeur = 5 Then TextBox2 = TextBox2 & "/"
End Sub

Private Sub CommandButton_Rechercher_Click()
 Dim VdateDebut, VdateFin

 If Not IsDate(Format(Me.TextBox1.Text, "dd/mm/yyyy")) Then
  MsgBox "Veuillez saisir une date valide"
   TextBox1 = ""
    TextBox1.SetFocus
 End If

 If Not IsDate(Format(Me.TextBox2.Text, "dd/mm/yyyy")) Then
  MsgBox "Veuillez saisir une date valide"
   TextBox2 = ""
    TextBox2.SetFocus
 End If

 On Error Resume Next
 Sheets("Recherche").ListObjects("TB_13").DataBodyRange.ClearContents

  With Worksheets("PPCM")
    If .FilterMode Then .ShowAllData
     VdateDebut = Format(CDate(TextBox1), "mm/dd/yyyy")
        VdateFin = Format(CDate(TextBox2), "mm/dd/yyyy")

    With .ListObjects("TB_1").Range
        .AutoFilter 2, ">=" & VdateDebut, xlAnd, "<=" & VdateFin
        .SpecialCells(xlVisible).Copy
         Sheets("Recherche").ListObjects("TB_13").DataBodyRange(1, 1).PasteSpecial Paste:=xlPasteValues
         Sheets("Recherche").ListObjects("TB_13").ListRows(1).Delete
        .AutoFilter Field:=2
    End With
  End With
  Application.CutCopyMode = False
End Sub

J'ai pas pu mettre de DatePicker car pas dispo sur ma version

Bizarre, car tu mentionne que tu es sous excel 2010, tout comme moi....

Version avec DTpicker

Bonne nuit,

Re,

Déjà merci beaucoup pour le travail effectué sur mon fichier.

Alors oui en effet j'ai oublié de préciser que je travail sur 3 Ordinateur avec des versions différentes.

Du coup la fonction TexBox est la plus simple, elle fonctionne mieux.

Juste un dernier soucis, j'ai copie / colle ton codage sur ma version Final et le tableau reste vide après la recherche !!!!!!!

Bonjour brutus01,

Un nouvel essai.....j'ai un peu miséré, mais ça fonctionne chez moi,

With Worksheets("PPCM")
    If .FilterMode Then .ShowAllData
      VdateDebut = CDate(TextBox1)
        VdateFin = CDate(TextBox2)

    With .ListObjects("TB_1").Range
        .AutoFilter 2, ">=" & VdateDebut, xlAnd, "<=" & VdateFin
        .SpecialCells(xlVisible).Copy
      With Sheets("Recherche")
        .Range("TB_13[Operateur]").PasteSpecial Paste:=xlPasteValues
        .ListObjects("TB_13").ListRows(1).Delete
      End With
        .AutoFilter Field:=2
    End With
  End With

Cordialement,

Hey xorsankukai

Super ça fonctionne, merci merci merci.

d'ou venez le problème ?

Re,

Super ça fonctionne

d'ou venait le problème ?

Il semblerait que cette ligne ne faisait pas son job...

Sheets("Recherche").ListObjects("TB_13").DataBodyRange(1, 1).PasteSpecial Paste:=xlPasteValues

En m'aidant de l'enregistreur de macro, je l'ai remplacé par

With Sheets("Recherche")
        .Range("TB_13[Operateur]").PasteSpecial Paste:=xlPasteValues

Tu peux supprimer le module 4, il t'est inutile,

EDIT :...Une autre version sans filtre avancé....

Cordialement,

Hello me revoila,

Du coup j'ai a nouveau un probleme les recherches entre les 2 dates fonctionnes mais le tableaux Recherche ce remplis mal

xorsankukai a écrit :

Re,

Super ça fonctionne

d'ou venait le problème ?

Il semblerait que cette ligne ne faisait pas son job...

Sheets("Recherche").ListObjects("TB_13").DataBodyRange(1, 1).PasteSpecial Paste:=xlPasteValues

En m'aidant de l'enregistreur de macro, je l'ai remplacé par

With Sheets("Recherche")
        .Range("TB_13[Operateur]").PasteSpecial Paste:=xlPasteValues

Tu peux supprimer le module 4, il t'est inutile,

EDIT :...Une autre version sans filtre avancé....

PPCM Final-3.xlsm

Cordialement,

Bonjour brutus01,

Voici une version sans filtre avancé, à tester....

Cordialement,

Hey good,

Cela m'a l'air plutôt bien, juste un problème de format date , voir photo

Re,

Comme ça alors....

Cordialement,

Super xorsankukai,

ça marche nickel, un grand merci a toi.

Derniere Question, sur ma feuille "PPCM" dans le Tableau TB_1 / Colone D "Temperature cabine

J'ai un soucis, je fait une mise en forme conditionnelle et ça ne fonctionne pas.

si j'écris manuellement dans la case cela fonctionne, mais des que les données sont extrait ça ne prend pas en compte.

Je ne sais pas si j'ai été clair ?

voir photo (en vert rentré a la main et non colorier exporté)

Re,

Ravi que cela te convienne,

Qu'entends-tu par

des que les données sont extrait ça ne prend pas en compte

Extrait comment ?

Cela doit venir du fait qu'excel considère les données de la colonne comme du texte.

Cordialement,

C'est extrait quand je vais sur le Userform PPCM et que j'enregistre ça envoie les informations dans ce tableau.

Du coup je n'arrive pas a mettre de MFC sur les colonnes.

Ce qui est bizarre c'est que le faite de changer le nombre manuellement ça fonctionne mais des que je fais un nouvelle enregistrement ça ne fonctionne plus.

Re,

Comme je te l'ai indiqué, excel considère que les valeurs renvoyées par tes Textbox sont du texte, tu dois donc lui dire qu'il s'agit de nombre....en rajoutant CDBL(ta textbox), ça doit passer,

 ActiveCell = ComboBox_operateur.Value
   ActiveCell.Offset(0, 1).Value = Label_date
   ActiveCell.Offset(0, 2).Value = CDbl(TextBox_Temp_Cabine)
   ActiveCell.Offset(0, 3).Value = Label_Consigne_Cabine
   ActiveCell.Offset(0, 4).Value = CDbl(TextBox_Hydrometrie)
   ActiveCell.Offset(0, 5).Value = Label4
   ActiveCell.Offset(0, 6).Value = CDbl(TextBox_Vitesse)
   ActiveCell.Offset(0, 7).Value = Label6
   ActiveCell.Offset(0, 8).Value = CDbl(TextBox1)
   ActiveCell.Offset(0, 9).Value = Label8

J'ai effectuer une saisie (ligne 14 : Vincent Dupré) et la MFC est bien prise en compte...

Bonne soirée,

Génial ça fonctionne 👍

Je te remercie encore une fois pour tes retours.

👌👌👌👌

Bonjour à tous,

Pour commencer j'espère que tout le monde ce porte bien et en bonne santé.

Me revoila après plusieurs semaines de confinement j'ai décidé de me remettre sur mon fichier tout fonctionnais bien jusqu'à …..

quand je fais ma recherche entre 2 date une erreur apparait et je n'arrive pas a la résoudre.

Pouvez-vous m'aider?

Bonjour brutus01,

J'ai oublié de déclarer les variables k et i,

Si tu rajoutes

Dim k As Integer, i As Integer

, ça refonctionne à nouveau (du moins chez moi, ).

Private Sub CommandButton_Rechercher_Click()
 Dim VdateDebut, VdateFin
 Dim tablo(), tabloR(), dateV
 Dim k As Integer, i As Integer
 etc....
 End Sub

Cordialement,

xorsankukai a écrit :

Bonjour brutus01,

J'ai oublié de déclarer les variables k et i,

Si tu rajoutes

Dim k As Integer, i As Integer

, ça refonctionne à nouveau (du moins chez moi, ).

Private Sub CommandButton_Rechercher_Click()
 Dim VdateDebut, VdateFin
 Dim tablo(), tabloR(), dateV
 Dim k As Integer, i As Integer
 etc....
 End Sub

Cordialement,

C'est tout ok, ça fonctionne.

Super je te remercie