filtrer avec plusieurs critères en VBA

blancolie · 12 Août 2020

Bonsoir le forum;

Dans ce fichier ci-joint et dans l'onglet données planning un filtrage avec plusieurs critères.Dans la feuille données planning j'ai mis en H1 , J1 et L1 et c'est dans les cellules au fond gris qu'on met les critères.

Je m'explique : le code suivant :

VB:

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

Ce code suivant qu'un membre m 'a gentiment construit en répondant à mon post précédent marche bien mais j'aimerais avoir un filtrage qui va plus dans le détail c'est a dire quand je sélectionne l'agent, j'aimerais qu'on puisse filtrer les différentes permanence et les différents périodes du même agent. j'espère avoir été assez clair. j'aimerais aussi faire l'inverse à partir de la période.

Si aucune cellule contenant de critères, faut que le filtrage s'efface. Peut-être que à partir d'un bouton, on peut réinitialiser mon petit menu ?

Cette liste est amené à s'agrandir ou à être diminué, don cil faut que le codage prenne en compte les rajouts de lignes ou de suppressions sinon, je risque d'avoir un erreur.

Merci à vous.

pouvez vous me mettre en parallèle le code au cas ou je n'arrive pas à ouvrir le fichier. cela m'arrive quelquefois a cause du vba. Merci à vous

blancolie · 19 Août 2020

Bon c'est peut-être réglé avec le type de format

patricktoulon · 19 Août 2020

donne moi un exemple de fichier actuel avec la date

blancolie · 19 Août 2020

ok je te fais cela, par contre pourquoi avaoir changer un peu le codage au début ?

patricktoulon · 19 Août 2020

re
ça ne te parait pas évident???

blancolie · 20 Août 2020

ah non , je vois pas. dans ce que jai fait en mettant 1 cela fonctionne mais si je modifi un agent le filtrage disparait

patricktoulon · 20 Août 2020

bonjour @blancolie
a ben si tu vois pas c'est pas du ressort de VBA là

réfléchi 1 seconde
avant ton tableau démarrait en A2 :F (X)
tes cellules pour taper étaient après ce tableau
il était donc obligé de contrôler que le change s'effectue après le 6(colonne F)

maintenant ton tableau est en A10
et tes celluler pour taper sont dans des colonnes que ce tableau utilise
il est évident que si je ne contrôle pas le exit sub va faire ce dont il doit faire et donc aucune action
j'ai donc plutôt que designer des colonnes ,désigné les cellules
comme ça il n'y a pas de méprise avec les colonnes
conclusion si tu modifie une de ces cellules ca agit sinon rien
c'est pour cela que j'ai supprimé la condition sur colonne et utiliser en debut un intersect

il n'est null besoins d’être un expert en VBA pour comprendre

blancolie · 14 Septembre 2020

Re-bonsoir,

dans ce fichier suivant avec le même filtrage, je n'arrive pas à comprendre malgré ce qu'on a fait au-dessus marche très bien.

J'ai utiliser ce code vba que j'ai adapté à mon fichier et dans l'ongle feuil7(BDD_Fleurs) :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
    ActiveSheet.AutoFilterMode = False
    If Intersect(Target, ActiveSheet.Range("I4,K4,I6,K6")) Is Nothing Then Exit Sub
    [G18].AutoFilter    'ca peux etre ca tout simplement
    Select Case Target.Column
    Case 9, 11
        If [I4] <> "" Then [G18].AutoFilter Field:=7, Criteria1:=[I4].Value
        If [K4] <> "" Then [G18].AutoFilter Field:=1, Criteria1:=[K4].Value
        If [I6] <> "" Then [G18].AutoFilter Field:=9, Criteria1:=[I6].Value
        If [K6] <> "" Then [G18].AutoFilter Field:=6, Criteria1:=[K6].Value
        If [I4] & [K4] & [I6] & [K6] = "" Then [G18].AutoFilter
    Case Else
        ActiveSheet.AutoFilterMode = False
    End Select
End Sub

La seule chose que je ne suis pas sur c'est case 9,11 à part cela, je vois pas ou cela peut merder.

Merci de votre aide

blancolie · 14 Septembre 2020

apparemment, c'est la ligne suivante qui pose problème :

Private Sub Worksheet_Change(ByVal Target As Range)

mais pourquoi ?

blancolie · 14 Septembre 2020

on me dit Nom ambigu détecté : Worksheet_Change. comment peux ton réoude cela ?
Apparemment, il faudrait les réunir les 2, comment faire ?

Merci

soan · 15 Septembre 2020

Bonjour blancolie,

* Option Explicit ne peut apparaître qu'une seule fois,
au début de la page de code VBA.

* Option Compare Text était bien mis une seule fois,
mais lui aussi doit être en haut de page.

* Une sub Worksheet_Change() ne peut apparaître qu'une seule fois
dans le code VBA d'une feuille ; sinon : « Nom ambigu détecté ».

Dans le fichier ci-dessous, il n'y a pas d'erreur de compilation ;
mais pour l'exécution, vérifie bien si ça fait correctement tout
ce que tu veux.

soan

blancolie · 15 Septembre 2020

merci merci je viens oui efffectivement de voir qu il faut le mettre qu une fois mais comment resoudre ce problème tout en laissant cela ds la meme feuille (feuil7) ?

soan · 15 Septembre 2020

ben, c'est déjà fait dans mon fichier joint !
il te suffit de lire le nouveau code VBA.

soan

soan · 15 Septembre 2020

Le code VBA actuel est celui-ci :

VB:

Option Explicit
Option Compare Text 'la casse est ignorée

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim liste$(), tablo, e, n&, DerLig
  If FilterMode Then ShowAllData 'si la feuille est filtrée
  '---liste à partir des colonnes sources---
  DerLig = Range("G65500").End(xlUp).Row
  ReDim liste(1 To Rows.Count, 1 To 1)
  tablo = Range(Cells(19, 7), Cells(DerLig, 7)) 'matrice, plus rapide, au moins 2 éléments,
  n = 0
  For Each e In tablo
    If e <> "" Then n = n + 1: liste(n, 1) = e
  Next
  '---restitution---
  Application.EnableEvents = False
  n = n + 19 ' n est le nombre d'éléments, 19 est le décalage des N° de lignes
  With [B19] '1ère cellule de restitution, à adapter
    If n Then
      .Resize(n) = liste
      .Resize(n).Name = "Liste"  'plage nommée
      ActiveSheet.ListObjects("Tableau6").Resize Range("$B$18:$E$" & n + 1)
      Range("D19").AutoFill Destination:=Range("D19:D" & n + 1), Type:=xlFillDefault
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1).ClearContents 'RAZ en dessous
    Range("B" & n + 2 & ":E" & Rows.Count).ClearContents
  End With
  Application.EnableEvents = True

  ActiveSheet.AutoFilterMode = False
  If Intersect(Target, ActiveSheet.Range("I4,K4,I6,K6")) Is Nothing Then Exit Sub
  [G18].AutoFilter 'ça peut être ça tout simplement
  Select Case Target.Column
  Case 9, 11
    If [I4] <> "" Then [G18].AutoFilter Field:=7, Criteria1:=[I4].Value
    If [K4] <> "" Then [G18].AutoFilter Field:=1, Criteria1:=[K4].Value
    If [I6] <> "" Then [G18].AutoFilter Field:=9, Criteria1:=[I6].Value
    If [K6] <> "" Then [G18].AutoFilter Field:=6, Criteria1:=[K6].Value
    If [I4] & [K4] & [I6] & [K6] = "" Then [G18].AutoFilter
  Case Else
    ActiveSheet.AutoFilterMode = False
  End Select
End Sub

soan

blancolie · 15 Septembre 2020

Bonjour et merci pour le fichier,

j'ai comme message d'erreur :

Erreur de compilation: Bloc If sans End If et après cela me met en jaune : Private Sub Worksheet_Change(ByVal Target As Range)

je vois pas ou placer le end if

en vous remerciant

ChTi160 · 15 Septembre 2020

Bonsoir Blancolie
Bonsoir le Fil ,le Forum
peut etre ici :

VB:

 If FilterMode Then 'ShowAllData 'si la feuille est filtrŽe

'ShowAllData est isolé donc : If FilterMode Then pose problème.
jean marie

filtrer avec plusieurs critères en VBA

blancolie

XLDnaute Impliqué

Pièces jointes

blancolie

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

blancolie

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

blancolie

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

blancolie

XLDnaute Impliqué

Pièces jointes

blancolie

XLDnaute Impliqué

blancolie

XLDnaute Impliqué

soan

XLDnaute Barbatruc

Pièces jointes

blancolie

XLDnaute Impliqué

soan

XLDnaute Barbatruc

soan

XLDnaute Barbatruc

blancolie

XLDnaute Impliqué

Pièces jointes

ChTi160

XLDnaute Barbatruc

Discussions similaires