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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichD
Le #25318772
Bonjour,

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
---------------------------------------------------------------
Jacky
Le #25319102
Parfait...
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"
Bonjour,

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
---------------------------------------------------------------

MichD
Le #25319112
| Range("AQ1") = "'" & Range("AP2").Formula

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
---------------------------------------------------------------
Jacky
Le #25319122
Ok !
Belle astuce
Mercis

--
Salutations
JJ


"MichD"
| Range("AQ1") = "'" & Range("AP2").Formula

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
---------------------------------------------------------------

MichD
Le #25319142
En survolant la procédure, je constate :

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
---------------------------------------------------------------
Jacky
Le #25319152
Pour A
Dans le classeur réel, je n'utilise que 'Feuil1'
Donc pas de problème

Pour B
Oui, je le fais toujours..

J'ai manqué de café...


Ah! si ce n'était pas si loin, ce serait un plaisir de te l'apporter.
;o)
--
Salutations
JJ


"MichD"
En survolant la procédure, je constate :

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
---------------------------------------------------------------

Jacky
Le #25319642
Suite......
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"
Pour A
Dans le classeur réel, je n'utilise que 'Feuil1'
Donc pas de problème

Pour B
Oui, je le fais toujours..

J'ai manqué de café...


Ah! si ce n'était pas si loin, ce serait un plaisir de te l'apporter.
;o)
--
Salutations
JJ


"MichD"
En survolant la procédure, je constate :

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
---------------------------------------------------------------





Yopop
Le #25319632
Le 04/04/2013 13:28, MichD a écrit :
En survolant la procédure, je constate :

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.



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
MichD
Le #25320972
| mais bon, cela fonctionne c'est l'essentiel

Enfin une bonne nouvelle!
Avais-je réellement un problème de café???
;-)))

MichD
---------------------------------------------------------------
Jacky
Le #25323072
.....
Avais-je réellement un problème de café???


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"
| mais bon, cela fonctionne c'est l'essentiel

Enfin une bonne nouvelle!
Avais-je réellement un problème de café???
;-)))

MichD
---------------------------------------------------------------

Publicité
Poster une réponse
Anonyme