Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Filtre sur 2 colonnes

10 réponses
Avatar
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

10 réponses

Avatar
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
---------------------------------------------------------------
Avatar
Jacky
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" a écrit dans le message de news: kjir0o$5oc$
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
---------------------------------------------------------------

Avatar
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
---------------------------------------------------------------
Avatar
Jacky
Ok !
Belle astuce
Mercis

--
Salutations
JJ


"MichD" a écrit dans le message de news: kjjlp7$bvm$
| 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
---------------------------------------------------------------

Avatar
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
---------------------------------------------------------------
Avatar
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" a écrit dans le message de news: kjjo48$il4$
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
---------------------------------------------------------------

Avatar
Jacky
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" a écrit dans le message de news: kjjp18$l8m$
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" a écrit dans le message de news: kjjo48$il4$
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
---------------------------------------------------------------





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

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

MichD
---------------------------------------------------------------
Avatar
Jacky
.....
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" a écrit dans le message de news: kjm7de$9h$
| mais bon, cela fonctionne c'est l'essentiel

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

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