[RESOLU] Afficher des lignes en fonction d'une date choisie

[MANHATTAN]

Bonjour à tous

Je recherche une macro permettant de filtrer le tableau joint "TEST DATE".

En fonction de la date affichée en M1
Le tableau affichera toutes les lignes dont cette date figure dans les colonnes B,C,D,G,H,J

J'espère que ma question est assez claire

Merci d'avance à ceux qui se pencheront sur mon problème.

Manhattan

 

[MANHATTAN]

Re : Afficher des lignes en fonction d'une date choisie

Je me suis peut être mal exprimé,

En fonction de la date choisie,
Le tableau affichera toutes les lignes qui comprennent cette date au moins dans l'une des colonnes indiquée. Les autres lignes seront masquées.
Si quelqu'un a une piste ?

 

[Bebere]

Re : Afficher des lignes en fonction d'une date choisie

bonjour Manhattan,le forum
bienvenue
pose toi la question est ce possible ce que je demande
une possibilité
tu entres une date en L2 et ensuite clic bouton

 

[Paf]

Re : Afficher des lignes en fonction d'une date choisie

Bonjour à tous

une autre proposition à mettre dans le code de la feuille:

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Montab, i As Long, j As Integer, Trouve As Boolean, DerL As Long
 If Not Intersect(Target, Range("M1")) Is Nothing Then
    DerL = Range("A2").EntireColumn.SpecialCells(xlCellTypeConstants).Count
    Application.ScreenUpdating = False
    Range("A2:J" & DerL).EntireRow.Hidden = False
    Montab = Range("A2:J" & DerL)
    For i = 1 To UBound(Montab, 1)
        Trouve = False
        For j = 1 To UBound(Montab, 2)
            If Montab(i, j) = Range("M1").Value Then
                Trouve = True
                Exit For
            End If
        Next
        If Not Trouve Then Rows(i + 1).EntireRow.Hidden = True
    Next
    Application.ScreenUpdating = True
 End If
End Sub

La saisie d'une date en M1 masque les lignes ne possédant pas cette date.

(Pas intégré de contrôle savoir si la saisie est bien une date )

A+

 

[job75]

Re : Afficher des lignes en fonction d'une date choisie

Bonsoir MANHATTAN, Bebere, Paf,

Avec le filtre avancé, entrez la date recherchée en M1 :

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
[K2] = IIf([M1] = "", True, "=SUMPRODUCT(N(M$1=B2:J2))")
Intersect([B:J], Me.UsedRange.EntireRow).AdvancedFilter xlFilterInPlace, [K1:K2]
[K2] = ""
Application.EnableEvents = True
End Sub

Effacer M1 pour tout afficher.

Edit : on peut aussi utiliser :

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
[K2] = IIf([M1] = "", True, "=COUNTIF(B2:J2,M$1)")
Intersect([B:J], Me.UsedRange.EntireRow).AdvancedFilter xlFilterInPlace, [K1:K2]
[K2] = ""
Application.EnableEvents = True
End Sub

A+

 

[MANHATTAN]

Re : [RESOLU] Afficher des lignes en fonction d'une date choisie

Tout d'abord merci à Bebere, Paf et Job 75 pour vos réponses et le temps passé sur ma demande.

Les solutions de Paf et Job 75 correspondaient tout à fait à ce que j'attendais sur le fichier que j'avais envoyé.
Cependant après avoir adapté ce code dans mon tableau qui comprenait beaucoup plus de colonnes et de lignes (plus de 8000) j'ai obtenu :
- pour le programme de Paf, une erreur sur la ligne "If Montab(i, j) = Range("AP1").Value Then"
- pour le programme de Job 75, un fonctionnement correct pour les recherches de date mais un problème lorsque je ne rentrait aucune date pour afficher toutes les lignes. Le programme avait l'air de boucler ou alors prenait un temps trop long pour afficher toutes les lignes.

J'ai donc modifié le code de Job 75 comme ceci:

Private Sub Worksheet_Change(ByVal Target As Range)

If Range("AP1") = "" Then
Columns("A:AN").Select
ActiveSheet.ShowAllData
Selection.AutoFilter
Else
Application.EnableEvents = False
[AO2] = IIf([AP1] = "", True, "=COUNTIF(N2:AD2,AP$1)")
Intersect([N:AD], Me.UsedRange.EntireRow).AdvancedFilter xlFilterInPlace, [AO1:AO2]
[AO2] = ""
Application.EnableEvents = True
End If
End Sub

Et ça fonctionne !!!
Un grand merci à Paf 75 pour sa fonction AdvancedFilter.

Ne me reste plus qu'à trouver comment archiver cette demande en "Résolu"