Filtrer un tableau entre deux date à partir de deux textbox

Bonjour,

Je suis un debutant et j'ai en train de faire un petit programme sous macro.

Mon problème est le filtrer de mon tableau entre deux dates :

j'ai reussie a filtre mon tableau quant je rempli uniquement textbox1 mais quant je saisie une date dans textbox2 et textbox3 le table n'affiche rien.

J'ai essayé des trucs, mais , je n'arrive pas à solutionner mon problème.

Je vous joins mon fichier.

Merci d'avance.

Bonjour toutes et tous

@ tester ci-joint

-désactivation provisoire des filtres de a1 à j1 dela feuille pai lorsqu'on clique sur le bouton de commande 2 de la feuille pair

Sub Bouton2_Cliquer()
' lancement de l'usf1
ActiveSheet.Range("$A$1:$i$1").AutoFilter

UserForm1.Show
End Sub

et l'usf1:

Option Explicit

Private Sub CommandButton1_Click()
' declarations des variables
Dim codecompt, date1, date2 As String

' en cas d'erreur
On Error Resume Next

codecompt = UserForm1.TextBox1.Value
date1 = UserForm1.TextBox2.Value
date2 = UserForm1.TextBox3.Value
 With Sheets("pai")

 ActiveSheet.ListObjects("Table1").Range.AutoFilter field:=2, Criteria1:=codecompt

 If UserForm1.TextBox2.Value <> "" Or UserForm1.TextBox3.Value <> "" Then Exit Sub

  ActiveSheet.ListObjects("Table1").Range.AutoFilter field:=6, Criteria1:= _
         ">=*& date1 &*", Operator:=xlAnd, Criteria2:="<=*&date2&*"
  ' End If

'UserForm1.TextBox4.Value = Sheets("pai").Range("K1").Value
End With
TextBox4 = Sheets("pai").Range("K1").Value
On Error GoTo 0
End Sub

Private Sub CommandButton2_Click()
' btn Annuler on décharge l'userform1
Unload Me
End Sub

Private Sub UserForm_Activate()

' on affiche le resultat de la texbox4 de la feuil pai de la cellule K1
TextBox4 = Sheets("pai").Range("K1").Value
End Sub

Private Sub UserForm_Initialize()
' on affiche le résultat de la texbox4 de la feuil pai de la cellule K1
TextBox4 = Sheets("pai").Range("K1").Value

End Sub

EDIT 01/06/2020 à 7:59: un énorme merci à Steelson ^^ pour ces 4 posts ci-dessous, je regarderai ce soir après mon job

crdlt,

André

Bonjour,

Pour moi cette formule

">=*& date1 &*", Operator:=xlAnd, Criteria2:="<=*&date2&*"

ne marche pas car date1 et date2 ne sont pas remplacés par leur valeur !

Il faut écrire ceci :

    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=6, Criteria1:= _
        ">=" & date1, Operator:=xlAnd, Criteria2:="<=" & date2

mais attention, avec les dates à l' "américaine" !!

donc, on inverse jour et mois ...

    date1 = (TextBox2.Value)
    date2 = (TextBox3.Value)

    date1 = Mid(date1, 4, 2) & "/" & Mid(date1, 1, 2) & "/" & Mid(date1, 7, 4)
    date1 = Mid(date2, 4, 2) & "/" & Mid(date2, 1, 2) & "/" & Mid(date2, 7, 4)

    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=6, Criteria1:= _
        ">=" & date1, Operator:=xlAnd, Criteria2:="<=" & date2

L'ennui, c'est que quand tu enregistre avec l’enregistreur de macro, cela te met "a priori" les dates en français, mais si tu lance cette même macro enregistrée, elle ne produit pas ce qui est attendu car cela n'est pas réversible !!

J'ai mis du temps à comprendre.

Je te donnerai une solution plus fiable sans passer par un userform !

Petite démo :

J'enregistre une macro

j'obtiens une macro que je peux retravailler :

Sub Macro1()
'
' Macro1 Macro
'

'
    ActiveSheet.ShowAllData
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=6, Criteria1:= _
        ">=01/04/2020", Operator:=xlAnd, Criteria2:="<=08/04/2020"
End Sub

je ré-applique la macro sans rien changer ... le résultat n'est pas celui attendu !

je vérifie les bornes

il s'agit maintenant du 4/1/2020 au 4/8/2020 !

Autre version, plus de problème de dates et code léger ...

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("L1:L3")) Is Nothing Then Exit Sub
    ActiveSheet.ShowAllData
    Range("Table1[[#Headers],[#Data]]").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("B1:D2"), Unique:=False
End Sub

Change les valeurs en colonne L et le tableau se mettra à jour de lui-même.

FRANCHEMENT C WOOOW

MERCI POUR TOUS