Microsoft 365 Amélioration code vba recherché

[blancolie]

Bonjour le forum,

ds ce fichier et dans l'onglet données planning, je souhaite faire un petit filtrage. Voici le code que j'ai adpaté :

Option Explicit
Option Compare Text 'la casse est ignor_e
Private Sub Worksheet_Change(ByVal Target As Range)

' Si le changement à lieu en cellule "A2"
If Not Application.Intersect(Target, Range("I1")) Is Nothing Then

    ThisWorkbook.Sheets("Données Planning").AutoFilterMode = False
    
    If Target.Value <> "" Then
        ' Filtre en Feuil1, sur la colonne 4, avec comme critère la valeur entrée
        ThisWorkbook.Sheets("données planning").Range("A1").AutoFilter Field:=3, Criteria1:=Target.Value
    End If

End If
' Si le changement à lieu en cellule "A2"
If Not Application.Intersect(Target, Range("K1")) Is Nothing Then

    ThisWorkbook.Sheets("Données Planning").AutoFilterMode = False
    
    If Target.Value <> "" Then
        ' Filtre en Feuil1, sur la colonne 4, avec comme critère la valeur entrée
        ThisWorkbook.Sheets("Données Planning").Range("A1").AutoFilter Field:=4, Criteria1:=Target.Value
    End If

End If
If Not Application.Intersect(Target, Range("M1")) Is Nothing Then

    ThisWorkbook.Sheets("Données Planning").AutoFilterMode = False
    
    If Target.Value <> "" Then
        ' Filtre en Feuil1, sur la colonne 4, avec comme critère la valeur entrée
        ThisWorkbook.Sheets("Données Planning").Range("A2").AutoFilter Field:=5, Criteria1:=Target.Value
    End If

End If

End Sub

Le soucis c'est que quand j'efface le critère recherché, le filtrage ne s'éfface pas. le Menu se situe dans l'onglet donnée planning juste à côté du tableau à filtrer; Agent : critère recherché puis permanence: critère recherché et période : critère recherché.)


Avez vous une solution pour que le filtrage s'éfface si pas de critère indiquée et peut-etre que vous connaissez un truc plus stylé (lol) . le but c'est de pouvoir remplacé un agent par un autre.

cordialemnt

 

[youky(BJ)]

Bonsoir Blancolie,
Voici fait à ma façon
Un textbox pour la recherche et un userform pour modifier ou mettre un Agent.
Bruno

 

[blancolie]

Bonjour Bruno, je vais regarder ton travail mais jbaurzis éviter un textbox ou userform car après il faut que je le reproduise sur le fichier original.

sans userform c est possible ?

 

[blancolie]

malheureusement, je peux pas lire le fichier

 

[patricktoulon]

re
perso je pige pas le besoins d'utiliser intersect pour tester le changement d'une cellule precise
et la prochaine tache que tes commentaires dans le code correspondent a ce que fait le code
j'aurais codé de cette manière

Option Explicit
Option Compare Text    'la casse est ignorée
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Sh As Worksheet

    Set Sh = ThisWorkbook.Sheets("Données Planning")
  ' set sh=thisworkbook.sheets1
 Sh.AutoFilterMode = False    'on vire le filtre des le depart

    Select Case Target.Address(0, 0)

        ' Si le changement à lieu en cellule "I1"
        ' on Filtre en Feuil1, sur la colonne 3, avec comme critère la valeur entrée
    Case "I1"
        If Target.Value <> "" Then
            Sh.Range("A1").AutoFilter Field:=3, Criteria1:=Target.Value
        End If

        ' Si le changement à lieu en cellule "K1"
        ' on Filtre en Feuil1, sur la colonne 4, avec comme critère la valeur entrée
    Case "K1"
        If Target.Value <> "" Then
            Sh.Range("A1").AutoFilter Field:=4, Criteria1:=Target.Value
        End If

        ' Si le changement à lieu en cellule "M1"
        'on  Filtre en Feuil1, sur la colonne 5, avec comme critère la valeur entrée
    Case "M1"
        If Target.Value <> "" Then
            Sh.Range("A2").AutoFilter Field:=5, Criteria1:=Target.Value
        End If

        ' si aucune cellule des cases correspondent on vire le filtre au cas ou il y en aurait encore un
    Case Else: Sh.AutoFilterMode = False
   
    End Select
End Sub

 

[blancolie]

merci patrick

mais le filtrage reste et ne s efface pas quand la cellule est vide en I1

 

[blancolie]

SH est une variable déclaré et rattaché à la feuille ?

 

[patricktoulon]

re
ben oui c'est clair en début de code de l'events non ?

 

[patricktoulon]

pas étonnant c'est un tableau structuré

Option Explicit
Option Compare Text    'la casse est ignorŽe
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Sh As Worksheet

    Set Sh = ThisWorkbook.Sheets("Données Planning")
  ' set sh=thisworkbook.sheets1
'Sh.AutoFilterMode = False    'on vire le filtre des le depart
  Range("T_Datas[[#Headers],[Date]]").AutoFilter'!!!!!!!!!

    Select Case Target.Address(0, 0)

        ' Si le changement ˆ lieu en cellule "I1"
        ' on Filtre en Feuil1, sur la colonne 3, avec comme critre la valeur entrŽe
    Case "I1"
        If Target.Value <> "" Then
            Sh.Range("A1").AutoFilter Field:=3, Criteria1:=Target.Value
        End If

        ' Si le changement ˆ lieu en cellule "K1"
        ' on Filtre en Feuil1, sur la colonne 4, avec comme critre la valeur entrŽe
    Case "K1"
        If Target.Value <> "" Then
            Sh.Range("A1").AutoFilter Field:=4, Criteria1:=Target.Value
        End If

        ' Si le changement ˆ lieu en cellule "M1"
        'on  Filtre en Feuil1, sur la colonne 5, avec comme critre la valeur entrŽe
    Case "M1"
        If Target.Value <> "" Then
            Sh.Range("A2").AutoFilter Field:=5, Criteria1:=Target.Value
        End If

        ' si aucune cellule des cases correspondent on vire le filtre au cas ou il y en aurait encore un
    Case Else: Sh.AutoFilterMode = False
 
    End Select
End Sub

tu peux aussi sans headr
Range("T_Datas").AutoFilter

 

[blancolie]

bonjour, j'ai une erreur d execution 1004 - la methode autofilder de l'objet range a echoué.

la ligne concerné : Range("T_Datas[[#Headers],[Date]]").AutoFilter '!!!!!!!!!

si j'enlève cette ligne, cela marche mais le filtrage reste quand même en place si la cellule est vide.

merci

 

[patricktoulon]

re
bonjour
ma fois j'ai testé sur le fichier en exemple en post 6 et ça fonctionne
essaie comme je t' ai dis aussi
Range("T_Datas").AutoFilter '!!!!!!!!!
après si la range n'accepte pas le filtre là j'y comprends plus rien

tiens voila ton fichier

 

[blancolie]

Je connais pas trop le vba. Range(tdatas).autofilter , je le place ou?

 

[patricktoulon]

re
teste mon fichier on en parle après

 

[blancolie]

Bonjour PAtricktoulon,

Peux-me mettre le codage du fichier post11 car ma version d'excel me dis qu'il peut pas l'ouvrir. Sur mon ordi de travail, cela fonctionne mais sur mon mac, cela ne s'ouvre pas.

En te remrciant

 

[patricktoulon]

tu met ca dans le module de la feuille données planning tout simplement
je t'ai réduis le code a peau de chagrin
tu vire ton code bien sur

Option Explicit
Option Compare Text    'la casse est ignorŽe
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Sh As Worksheet, col&

    Set Sh = ThisWorkbook.Sheets("Données Planning")

    [A1].AutoFilter 'ca peux etre ca tout simplement
    
    
    Select Case Target.Address(0, 0)
    Case "I1": col = 3
    Case "K1": col = 4
    Case "M1": col = 5
    Case Else: col = 0:
    End Select

    If Target.Value <> "" And col <> 0 Then
        [A1].AutoFilter Field:=col, Criteria1:=Target.Value
    Else
        Sh.AutoFilterMode = False
    End If
End Sub