Colonnes d'un tableau

Bonjour,

Simple question: Comment filtrer plusieurs colonnes d'un tableau? On peut le faire pour une, mais des fois j'ai les mêmes données dans 2 autres colonnes et donc il faudrait garder celles-ci aussi ...

Voici mon fichier:

J'ai besoin de filtrer les dates en colonnes M O Q dans l'onglet Historique des gardes.

Merci !

J'ai essayé avec ce code VBA mais il ne fonctionne pas ... Je vois qu'il prend bien en compte le filtrage mais tout mon tableau s'efface donc plus rien ...

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$M$2" Then Exit Sub
    With ActiveSheet
        If .[M2] = "" Then
            .AutoFilterMode = False
        Else
            .Range(.[A5], .Cells(.Rows.Count, 21).End(xlUp)).AutoFilter 13, .[M2]
            .Range(.[A5], .Cells(.Rows.Count, 21).End(xlUp)).AutoFilter 15, .[M2]
            .Range(.[A5], .Cells(.Rows.Count, 21).End(xlUp)).AutoFilter 17, .[M2]
        End If
    End With
End Sub

Bonjour,

Un début de réponse.

Cdlt.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
    If Target.Address = "$M$2" And IsDate(Target.Value) Then
        Set Rng = Me.ListObjects(1).Range
        Rng.AdvancedFilter _
                Action:=xlFilterInPlace, _
                criteriarange:=Range("Criteria"), _
                unique:=False
    Else
        Me.ShowAllData
    End If
    Set Rng = Nothing
End Sub

Cela fonctionne mais est-il possible de masquer la zone de critère (les 3 colonnes ajoutés après) ?

De plus, lorsque j'efface mon critere dans le champs, il y a des lignes en gras (qui est en fait la fin de mon tableau) et donc une fois le champs supprimé cette ligne se répercute à la dernière ligne du filtre (donc quand c'est filtré). Tu peux faire le test tu comprendras surement mieux que mon explication

Apparemment le problème de la ligne en gras a été résolue en relancant le fichier ... peut-etre un bug ?

Par contre les autres colonnes, je peux les masquer ou supprimer ? Je pense qu'elles ne sont pas utilisée si ?

EDIT: J'ai un soucis en lancant une sauvegarde voir feuille encodage il m'indique un message d'erreur avec MeShowAllData et ce juste quand j'ai changé l'intitulé "Filtre date:" j'ai eu aussi un message d'erreur :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
    If Target.Address = "$M$2" And IsDate(Target.Value) Then
        Set Rng = Me.ListObjects(1).Range
        Rng.AdvancedFilter _
                Action:=xlFilterInPlace, _
                criteriarange:=Range("Criteria"), _
                unique:=False
    Else
        Me.ShowAllData
    End If
    Set Rng = Nothing
End Sub

Voir dans mon fichier :

RE,

Tu peux masquer la zone de critères mais pas la supprimer.

Profite pour regarder l'aide Excel sur le filtre avancé !

Cdlt.

EDIT: J'ai un soucis en lancant une sauvegarde voir feuille encodage il m'indique un message d'erreur avec MeShowAllData et ce juste quand j'ai changé l'intitulé "Filtre date:" j'ai eu aussi un message d'erreur : En gros ma macro "Sauvegarde" ne fonctionne plus

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
    If Target.Address = "$M$2" And IsDate(Target.Value) Then
        Set Rng = Me.ListObjects(1).Range
        Rng.AdvancedFilter _
                Action:=xlFilterInPlace, _
                criteriarange:=Range("Criteria"), _
                unique:=False
    Else
        Me.ShowAllData
    End If
    Set Rng = Nothing
End Sub

Voir dans mon fichier :

Re,

Une rustine avec EnableEvents dans la procédure Sauvegarder.

Cdlt.

Voilà que j'encode quelque chose dans les dates, donc une nouvelle date et ça le refait, du coup ca ne refonctionne plus :s En gros, des que je fais un changement dans le tableau ca ne fonctionne plus. Il faut prendre en compte qu'en sauvegardant, ça ajoute des lignes à la suite du tableau et que j'encoderai des dates dedans. Donc ca me remet le message de ShowAllData.

En fait, si tu reprends le fichier ci-joint, tu peux voir que si je veux passer d'un "Cloturé" dans mon tableau historique des gardes à quelque chose d'autre, j'ai l'erreur qui apparait et puis plus rien ne fonctionne :s

Bonjour,

Modifie la procédure évènementielle ainsi :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
    If Target.Address = "$M$2" Then
        If IsDate(Target.Value) Then
            Set Rng = Me.ListObjects(1).Range
            Rng.AdvancedFilter _
                    Action:=xlFilterInPlace, _
                    criteriarange:=Range("Criteria"), _
                    unique:=False
        Else
            Me.ShowAllData
        End If
    End If
End Sub

Et supprime les lignes EnableEvents de la procédure Sauvegarder.

A te relire.

Cdlt.

Ca fonctionne, merci !!

Re salut Jean Eric !

Je ne sais pas ce que j'ai été touché .. ta macro ne refonctionne plus ..

Peux-tu y jeter un dernier coup d'oeil ?

Bonjour,

Je ne constate pas de dysfonctionnement sinon la MFC jaune à revoir.

Peux-tu être plus précis ?

Cdlt.

Apparemment il s'agissait d'un bug .. Je l'ai ouvert sur 2 autres pcs et ça a fonctionné ... Désolé pour le dérangement!

Concernant la MFC, c'est réglé !

Re,

Je t'avais demandé de supprimer les lignes EnableEvents de la procédure Sauvegarder et tu ne l'a pas fait.

Attention !

Cdlt.

Je pensais pourtant l'avoir fait :p Si je supprime la ligne Enable... ma macro ne fonctionne plus :/

Sub sauvegarder()
Dim n%
Dim sh As Worksheet
Dim shDest As Worksheet

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set sh = Sheets("Encodage des gardes")
    Set shDest = Sheets("Historique des gardes")

    With sh

        n = .Range("D57").End(xlUp).Row

        If n = 1 Then Exit Sub: n = n - 1

        If shDest.Range("A6").Value = "" Then
            lig = shDest.Range("tabhisto[Acte]").End(xlUp).Row + 1
        Else
            lig = shDest.Range("D" & Rows.Count).End(xlUp).Row + 1
        End If

        shDest.Range("A" & lig).Resize(n).Value = .Range("B10").Resize(n).Value
        shDest.Range("B" & lig).Resize(n).Value = .Range("C10").Resize(n).Value
        shDest.Range("C" & lig).Resize(n).Value = .Range("D10").Resize(n).Value
        shDest.Range("D" & lig).Resize(n).Value = .Range("F10").Resize(n).Value    'copie les valeurs cibles = provenance
        shDest.Range("E" & lig).Resize(n).Value = .Range("J10").Resize(n).Value
        shDest.Range("F" & lig).Resize(n).Value = .Range("G10").Resize(n).Value
        shDest.Range("G" & lig).Resize(n).Value = .Range("H10").Resize(n).Value
        shDest.Range("H" & lig).Resize(n).Value = .Range("N10").Resize(n).Value
        shDest.Range("I" & lig).Resize(n).Value = .Range("O10").Resize(n).Value
        shDest.Range("J" & lig).Resize(n).Value = .Range("I10").Resize(n).Value
        shDest.Range("K" & lig).Resize(n).Value = .Range("Q10").Resize(n).Value
        shDest.Range("L" & lig).Resize(n).Value = .Range("M10").Resize(n).Value

        sh.Range("E10:I57").ClearContents    'efface le contenu
        sh.Range("K10:O55").ClearContents
        sh.Range("R10:R51").ClearContents
        sh.Range("F5:F7").ClearContents
    End With

    shDest.Activate
    nnn = Range("D" & Rows.Count).End(xlUp).Row

    For Each cell In Range("A6:U" & nnn)
        r = cell.Row
        If Range("D" & r).Value = "" Then
            Exit For
        End If
    Next cell

    ActiveSheet.ListObjects("tabhisto").Resize Range("$A$5:$U$" & r - 1)
    Range("A" & r & ":U" & nnn).Clear

    With Range("A" & r - 1 & ":U" & r - 1).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 10
        .TintAndShade = 0
        .Weight = xlMedium
    End With

    For Each lign In Range("A6:A" & r - 1)
        a = lign.Row
        If Range("A" & a).Value = "" Then
            Exit For
        End If
    Next lign
    'Application.CutCopyMode = False

    sh.Activate
    Range("C5").Select

End Sub

Qu'est-ce qui est à supprimer ici ?

Re,

Merci beaucoup !

Encore moi Jean Eric

J'ai encore fait des modifications dans mon code "Sauvegarder" et rebelotte ta macro "filtrer" ne s'execute plus ...

Sinon, juste me dire clairement la modification que je dois faire pour ne plus que je revienne vers toi

Parce que je vais devoir encore faire beaucoup de changements ...