Macro pour filtrer une date en fonction de la date de ce jour

[balkan59]

Bonjour à tous,
Voilà j'ai un petit soucis je vous ai fait vraiment vite un petit exemple...
En fait par l'action d'un bouton j'aimerais filtrer une liste dans une autre feuille pour afficher les dates qui sont comprise par rapport à la date du jour entre +15 et -15 jours.
Je recommence supposons que T est la date d'aujourd'hui je voudrais afficher ce qui est entre T+15 et T-15 de façon à extrpoler et à suivre une situation...
je vous joins l'exemple pour ce ca vous parle un peut plus Merci de votre patience

 

[kjin]

Re : Macro pour filtrer une date en fonction de la date de ce jour

bonsoir,

Dim x#, y#
ActiveSheet.AutoFilterMode = False
x = CLng(Date) - 15
y = CLng(Date) + 15
Range("A1").AutoFilter Field:=3, Criteria1:=">=" & x, Operator:=xlAnd, Criteria2:="<=" & y

A+
kjin

 

[Efgé]

Re : Macro pour filtrer une date en fonction de la date de ce jour

Bonjour bAlkAn59,
Comme tu ne fourni rien comme début, et que c'est jour de bonté
Une solution par MFC

=ET($C1 > =AUJOURDHUI()-15;$C1 < =AUJOURDHUI()+15)

Un solution par formule:

=INDEX(Feuil1!$A1:$A1000;EQUIV((AUJOURDHUI()-16)+LIGNES($1:1);Feuil1!$C1:$C1000;0);COLONNES($A:A))

Une par macro, au plus rapide (pour moi...) :

Private Sub CommandButton1_Click()
Dim i&, j&, k&, T As Variant, TReport(1 To 32, 1 To 3) As Variant
k = 1
T = Range(Cells(1, 1), Cells(Rows.Count, 3).End(3))
For j = 1 To 3
    TReport(k, j) = T(k, j)
Next j
For i = LBound(T, 1) To UBound(T, 1)
    If T(i, 3) > = Date - 15 And T(i, 3) < = Date + 15 Then
        k = k + 1
        For j = 1 To 3
            TReport(k, j) = T(i, j)
        Next j
    End If
Next i
With Sheets("Feuil2")
    .UsedRange.ClearContents
    .Cells(1, 1).Resize(k, UBound(TReport, 2)) = TReport
    .Activate
End With
End Sub

Cordialement

 

[kjin]

Re : Macro pour filtrer une date en fonction de la date de ce jour

re, salut Efge ,

....
et que c'est jour de bonté

Ah bin j'aime bien...
A+
kjin

 

[Robert]

Re : Macro pour filtrer une date en fonction de la date de ce jour

Bonjour, Balkan et bienvenu, Bonjour Kjin, Efgé, bonjour le forum,

Une proposition VBA avec le code ci-dessous (après la bagarre...) :

Private Sub CommandButton1_Click()
Dim d As Date 'déclare la variable d (Date de référence)
Dim a As Long 'déclare la varialbe a (Année)
Dim dm As Date ''déclare la variable dm (Date de référence Moins 15 jours)
Dim dp As Date 'déclare la variable dp (Date de référence Plus 15 jours)

ActiveCell.Select 'enlève le focus au bouton
With Sheets("Feuil1") 'prend en compte l'onglet "Feuil1"
    If .FilterMode = True Then .Range("A1").AutoFilter 'si l'onglet est en mode filtre, annule le filtre
    If .Range("F1").Value = "" Then 'condition : si F1 est vide
        MsgBox "Vous devez taper la date de référence en F1 !" 'message
        .Range("F1").Select 'sélectionne F1
        Exit Sub 'sort de la procédure
    Else 'sinon
        d = CDate(.Range("F1")) 'définit la date d
        dm = d - 15 'définit la date dm
        dp = d + 15 'définit la date dp
        a = Year(d) 'définit l'année a
    End If 'fin de la condition
    .Range("A1").AutoFilter 'lance le mode filtre automatique
    'filtre automatique personnalisé de la colonne C sur le critère 1 et le critère 2
    .Range("A1").AutoFilter Field:=3, Criteria1:=">=" & Format(Month(dm), "00") & "/" & Format(Day(dm), "00") & "/" & a, Operator:=xlAnd, _
       Criteria2:="<=" & Format(Month(dp), "00") & "/" & Format(Day(dp), "00") & "/" & a
End With 'fin de la prise en compte de l'onglet "Feuil1"
End Sub

Le fichier :

 

[balkan59]

Re : Macro pour filtrer une date en fonction de la date de ce jour

merci beaucoup,
Pour vos réponses je vais essayé vos méthodes en les décorticant pour bien les comprendre
Désoler si je n'ai pas été très clair
Je ne manquerais pas de vous faire savoir l'avancée de mon projet....
Merci encore

 

[Efgé]

Re : Macro pour filtrer une date en fonction de la date de ce jour

Re balkan59
Pour saluer kjin que n'avais point vu, désolé, et pour saluer Robert qui nous a rejoins
Cordialement

 

[balkan59]

Re : Macro pour filtrer une date en fonction de la date de ce jour

Bonsoir,
Efgé je viens de décortiquer toutes vos propositions mais je cale un peu sur ta proposition de code vba :

Private Sub CommandButton1_Click()
Dim i&, j&, k&, T As Variant, TReport(1 To 32, 1 To 3) As Variant
k = 1
T = Range(Cells(1, 1), Cells(Rows.Count, 3).End(3))
For j = 1 To 3
TReport(k, j) = T(k, j)
Next j
For i = LBound(T, 1) To UBound(T, 1)
If T(i, 3) > = Date - 15 And T(i, 3) < = Date + 15 Then
k = k + 1
For j = 1 To 3
TReport(k, j) = T(i, j)
Next j
End If
Next i
With Sheets("Feuil2")
.UsedRange.ClearContents
.Cells(1, 1).Resize(k, UBound(TReport, 2)) = TReport
.Activate
End With
End Sub

j'ai beau me creuser la tête je ne comprends pas très bien
pourriez vous développez un peut pour que je comprenne la logique Merci

 

[kjin]

Re : Macro pour filtrer une date en fonction de la date de ce jour

Salut,
Je viens de comprendre qu'il fallait copier les données issues du filtre dans une autre feuille (ici la feuille 2)

Private Sub CommandButton1_Click()
dim r as Range, deb, fin
deb = InputBox("date début ? (jj/mm/aa)")
If deb = "" Or Not IsDate(deb) Then Exit Sub
fin = InputBox("date fin ? (jj/mm/aa)")
If fin = "" Or Not IsDate(fin) Then Exit Sub
With Sheets("Feuil1")
    Set r = .Range("A1").CurrentRegion
End With
With Feuil2
    .Cells.Clear
    .[A1] = "Dates"
    .[A2] = ">=" & deb
    .[B1] = "Dates"
    .[B2] = "<=" & fin
    r.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=.Range("A1:B2"), CopyToRange:=.Range("A3")
    '.Rows("1:2").Delete
End With
End Sub

A+
kjin

 

[Efgé]

Re : Macro pour filtrer une date en fonction de la date de ce jour

Bonjour balkan59, kjin , Robert , le fil, le forum
Voici les commentaires demandés:

Option Explicit
Private Sub CommandButton1_Click()
'T est le tableau des données
'TReport est le tableau de l'extraction
'32 lignes sur 3 colonnes (si il y a des dates en doubles dans la liste
'il faudra augmenter cette valeur
Dim i&, j&, k&, T As Variant, TReport(1 To 32, 1 To 3) As Variant
k = 1
'On monte toutes les valeurs de la feuille
'dans un tableau (T)
T = Range(Cells(1, 1), Cells(Rows.Count, 3).End(3))
'On met les valeurs d'en tete sur la ligne 1 du tableau de données
'sur la ligne 1 du tableau d'extraction (k = ligne, j = colonne)
For j = 1 To 3
    TReport(k, j) = T(k, j)
Next j
'Pour chaque ligne du tableau de données
For i = LBound(T, 1) To UBound(T, 1)
    'Si la valeur en colonne 3 de la ligne i
    'est égale ou sépérieure à la date d'aujourdhui - 15 ET
    'est égale ou inférieure )à la date du jour + 15
    If T(i, 3) > = Date - 15 And T(i, 3) < = Date + 15 Then
        'on augmente la variable k (k = ligne)
        k = k + 1
        'On rempli la ligne k du tableau d'extraction
        'avec les valeurs de la ligne i du tableau de données
        ' ( j = colonnes)
        For j = 1 To 3
            TReport(k, j) = T(i, j)
        Next j
    End If
Next i
'Avec la feuille2
With Sheets("Feuil2")
    'on supprime les valeurs qui sont présentent sur la feuille
    .UsedRange.ClearContents
    'on colle le tableau d'extraction sur la cellule A1 re-dimentionnée
    'de k lignes sur 3 colonnes
    'UBound(TReport, 2) = le nombre de colonnes du tableau TReport
    'Voir Resize dans l'aide
    .Cells(1, 1).Resize(k, UBound(TReport, 2)) = TReport
    'on affiche la feuille (pour marquer que le traitement est fini ;)
    .Activate
End With
End Sub

N'hésite pas à revenir si tu veux d'autes précisions.
Cordialement