Filtre sur 2 colonnes
Le
Jacky
Hello,
Je souhaite sur une Base de données un filtre sur 2 colonnes (EN VBA)
La Plage est en A1: ANxxx
- En ligne 1==> Les titres
- En colonne A des codes sous forme de chiffres
- En colonne AN des dates(reconnues comme date par xl)
Je cherche à faire un filtre sur un code (colonne A) ET sur un jour de semaine de la date (Colonne AN)
Par exemple
Le code '1325' de la colonne A et les 'Lundi' de la colonne AN
ou encore
Le code 'xxxx" de la colonne A et les jours différents de 'Lundi' et 'Vendredi'
Ensuite la somme des colonnes 'V','Y','AB','AE','AH' en résultat du filtre.
Mon "neurone restant" fait grève, et je n'obtiens pas de bon résultat.
Merci de la participation.
--
Salutations
JJ
Je souhaite sur une Base de données un filtre sur 2 colonnes (EN VBA)
La Plage est en A1: ANxxx
- En ligne 1==> Les titres
- En colonne A des codes sous forme de chiffres
- En colonne AN des dates(reconnues comme date par xl)
Je cherche à faire un filtre sur un code (colonne A) ET sur un jour de semaine de la date (Colonne AN)
Par exemple
Le code '1325' de la colonne A et les 'Lundi' de la colonne AN
ou encore
Le code 'xxxx" de la colonne A et les jours différents de 'Lundi' et 'Vendredi'
Ensuite la somme des colonnes 'V','Y','AB','AE','AH' en résultat du filtre.
Mon "neurone restant" fait grève, et je n'obtiens pas de bon résultat.
Merci de la participation.
--
Salutations
JJ
Essaie ceci :
Les explications sont dans le code
'----------------------------------------------
Sub test()
Dim Rg As Range, Code As Long
Dim DerLig As Long, Sh As Worksheet
Dim M As Double, N As Double, O As Double
Dim P As Double, Q As Double, Message As String
Range("AQ1") = "'" & Range("AP2").Formula
'*************Variables à définir*************
Set Sh = Worksheets("Feuil1") 'NOm feuille à adapter
'Valeur du code recherché en colonne A:A
Code = 1325
'***************************************************
Application.EnableEvents = True
Application.ScreenUpdating = True
With Sh
DerLig = .Range("A:AN").Find("*", _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'Plage de critère
.Range("AP1") = ""
'Formule pour la condition :
'A:A = code = ??? et AN:AN = jour semaine "lundi"
'Formule = "=((A2=" & Code & _
")+(WEEKDAY(AN2,2)=1))=2"
'Formule pour code = ?? et Jour semaine ni lundi
' et ni vendredi
Formule = "=((A2=" & Code & _
")+(WEEKDAY(AN2,2)<>{1,5}))=2"
'Tu active la formule selon le critère que tu veux
'appliquer
.Range("AP2").Formula = Formule
'Formule pour code = ?? et Jour semaine ni lundi
' et ni vendredi
'Formule = "=((A2=" & code & _
")+(WEEKDAY(AN2,2)<>{1,5}))=2"
Set Rg = .Range("A1:AN" & DerLig)
End With
With Rg
.AdvancedFilter xlFilterInPlace, Feuil1.Range("AP1:AP2")
M = Application.Subtotal(9, .Columns(22))
N = Application.Subtotal(9, .Columns(25))
O = Application.Subtotal(9, .Columns(28))
P = Application.Subtotal(9, .Columns(31))
Q = Application.Subtotal(9, .Columns(34))
Message = "Somme de la colonne V : " & M & vbCrLf
Message = Message & "Somme de la colonne Y : " & N & vbCrLf
Message = Message & "Somme de la colonne AB : " & O & vbCrLf
Message = Message & "Somme de la colonne AE : " & P & vbCrLf
Message = Message & "Somme de la colonne AH : " & Q
End With
sh.Range("AP2") = ""
Sh.ShowAllData 'Désactive cette ligne de code
' si tu veux voir la feuille en mode filtré.
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox Message
End Sub
'----------------------------------------------
MichD
---------------------------------------------------------------
Mille mercis Denis
Mon neurone a cessé de fumer.
Il y a des jours où l'on bute sur un code et quand on part dans une mauvaise direction, on s'enfonce.
Je n'ai pas trouvé le rôle de:
'--------------
Range("AQ1") = "'" & Range("AP2").Formula
'--------------
--
Salutations
JJ
"MichD"
J'ai omis de commenter, désolé. Quand j'écris
le code, je débute en écrivant la formule dans une
cellule et je la teste en exécutant le
filtre avancé avant de m'assurer que le résultat
attendu est au rendez-vous.
Lorsque cela fonctionne, cette ligne de code permet
de transposer en anglais la formule utilisée dans une
cellule de mon choix. Tu peux utiliser le contenu de
cette cellule pour le code en l'adaptant au besoin...
Cette traduction pose souvent problème aux usagers! Cela simplifie le
travail!!
Formule = "=((A2=" & Code & _
")+(WEEKDAY(AN2,2)=1))=2"
MichD
---------------------------------------------------------------
Belle astuce
Mercis
--
Salutations
JJ
"MichD"
A ) pour cette ligne de code :
.AdvancedFilter xlFilterInPlace, Feuil1.Range("AP1:AP2")
J'ai omis de remplacer "Feuil1" par la variable Sh
B ) Sh.ShowAllData
Quand on utilise cette ligne de code, il est conseillé
d'ajouter "On Error Resume Next" juste avant. Cette ligne
de code provoque une erreur si tu n'as pas au moins un
enregistrement répondant au critère retenu.
J'ai manqué de café...
;-))
MichD
---------------------------------------------------------------
Dans le classeur réel, je n'utilise que 'Feuil1'
Donc pas de problème
Pour B
Oui, je le fais toujours..
Ah! si ce n'était pas si loin, ce serait un plaisir de te l'apporter.
;o)
--
Salutations
JJ
"MichD"
J'ai du remplacer la formule
==> .[AQ2].Formula = "=((A2=" & .Cells(i, "ap").Value & ")+(WEEKDAY(AN2,2)<>{1,5}))=2"
Par celle-ci
==> .[AQ2].Formula = "=((A2=" & .Cells(i, "ap").Value & ")+(WEEKDAY(AN2,2)<>1)+(WEEKDAY(AN2,2)<>5))=3"
Elle ne prenait pas en compte le 'Vendredi' (5) dans le comptage
Sur la feuille cette partie de la formule est transformée en ....)<>{15}))=2"
J'ai essayé plusieurs séparateur différents sans succès.
Bizarre! mais bon, cela fonctionne c'est l'essentiel
--
Salutations
JJ
"Jacky"
Bonjour Denis, Jacky
Pour ce point, je vous propose un :
if Sh.FilterMode then Sh.ShowAllData
qui évite l'utilisation du On error ...
j-p
Enfin une bonne nouvelle!
Avais-je réellement un problème de café???
;-)))
MichD
---------------------------------------------------------------
Comme tu as mis
"Application.EnableEvents" et "application.ScreenUpdating"
à true en début de macro, je double la dose de caféine
;-))))
Punition...Interdit de ctrl V
--
Salutations
JJ
"MichD"