XL 2010 Utilisation filtre avancée en VBA

jeanmi · 8 Décembre 2024

Bonjour à tous,

J’ai enregistré une macro pour faire un filtre avancé afin de copier les données filtrées de l’onglet base de données, vers l’onglet copie.

J’utilise un menu déroulant au niveau de l’onglet copie pour définir le choix du filtre.

Ça fonctionne bien, mais :

Je n’arrive pas à trouver s’il y a une solution pour prendre en compte toutes les dates d’une année ?

Je poste mon fichier d’essai pour mieux comprendre.

Merci pour l’aide, si c’est possible.

Cordialement

ALS35 · 8 Décembre 2024

Bonjour de nouveau,
Alors tu peux faire avec une formule dans le filtre avancé, en A2 surtout sans étiquette en A1 et choix de l'année par ailleurs en I2
Cordialement

TooFatBoy · 8 Décembre 2024

Bonjour,

Une proposition :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim DateDeb As Long, DateFin As Long

    If Target.Address = "$A$2" Then
        Sheets("copie").Range("A5:K16").Clear
        DateDeb = Sheets("copie").Range("A2").Value
        DateFin = DateAdd("yyyy", 1, DateDeb) - 1
        Sheets("base données").Range("A1:K37").AutoFilter Field:=1, Criteria1:=">=" & DateDeb, Operator:=xlAnd, Criteria2:="<=" & DateFin
        On Error Resume Next
        Sheets("base données").Range("A2:A37,I2:K37").SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("copie").Range("A5")
        Sheets("base données").Range("E2:G37").SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("copie").Range("E5")
        Sheets("base données").Range("A1:K37").AutoFilter
    End If

End Sub

jeanmi · 8 Décembre 2024

TooFatBoy à dit:

Bonjour,

Une proposition :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim DateDeb As Long, DateFin As Long

    If Target.Address = "$A$2" Then
        Sheets("copie").Range("A5:K16").Clear
        DateDeb = Sheets("copie").Range("A2").Value
        DateFin = DateAdd("yyyy", 1, DateDeb) - 1
        Sheets("base données").Range("A1:K37").AutoFilter Field:=1, Criteria1:=">=" & DateDeb, Operator:=xlAnd, Criteria2:="<=" & DateFin
        On Error Resume Next
        Sheets("base données").Range("A2:A37,I2:K37").SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("copie").Range("A5")
        Sheets("base données").Range("E2:G37").SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("copie").Range("E5")
        Sheets("base données").Range("A1:K37").AutoFilter
    End If

End Sub

Bonjour @TooFatBoy à tous,

Merci @TooFatBoy , pour cette solution qui fonctionne trés bien.

J'ai mis cette macro dans la feuille "copie"

Par contre, si je change dans les données de la liste déroulante "01/01/2022" en uniquement "2022" comme je souhaité le faire, cela ne fonctionne plus.

Que faut-il faire ?

Merci pour l'aide.

cordialement

TooFatBoy · 8 Décembre 2024

jeanmi à dit:
Par contre, si je change dans les données de la liste déroulante "01/01/2022" en uniquement "2022" comme je souhaité le faire, cela ne fonctionne plus.

Évidemment : j'ai fait avec ce que tu as donné.

jeanmi à dit:
Que faut-il faire ?

Poser le problème correctement dès le début pour éviter de tout refaire plusieurs fois.

Bon dimanche

ALS35 · 8 Décembre 2024

Bonjour à tous,
Le plus simple est peut-être de mettre une colonne année dans ta BD. Dis si tu peux.
Cordialement

jeanmi · 8 Décembre 2024

TooFatBoy à dit:
Évidemment : j'ai fait avec ce que tu as donné.

Poser le problème correctement dès le début pour éviter de tout refaire plusieurs fois.

Bon dimanche

Bonjour @TooFatBoy à tous,

Toutes mes excuses, mais pour moi le problème était posé correctement.

J'ai même noté dans l'onglet "liste déroulante « case à remplacer pour n'avoir que les années mais comment faire pour n’avoir que les données d’une année, recopiées vers l’onglet copie ?».

Peut-être que c'était clair pour moi mais pas suffisamment clair pour une autre personne.
Il faut être indulgent.
Ce n’ai peut-être pas toujours facile de définir un besoin avec des mots justes qui puissent être compris par une autre personne.

Merci quand même pour ta réponse.
Je vais faire avec, puisqu’elle peut répondre partiellement à ce que j’espérais faire, c’est déjà bien.

Bon dimanche.

Cordialement

jeanmi · 8 Décembre 2024

ALS35 à dit:
Bonjour à tous,
Le plus simple est peut-être de mettre une colonne année dans ta BD. Dis si tu peux.
Cordialement

Bonjour @ALS35 à tous,

Non, pas possible, effectivement avec un filtre avancé tout était plus simple dans ce cas.

Après réfection effectivement, je peux extraire uniquement l’année dans une autre colonne, pour pouvoir filtrer sur celle-ci, MAIS, lorsque je vais récupérer des nouvelles données, il me faudra remettre cette colonne.

C’est aussi une solution.

Peut-être extrait toutes les années disponibles dans ma base de donnée, les mettre dans la liste déroulant (uniquement un fois chaque année), mais là cela me semble compliqué, pour moi.

Bon je vais refléchir à tout ça.

Merci pour ta réponse.

Cordialement

ALS35 · 8 Décembre 2024

Bonjour de nouveau,
Alors tu peux faire avec une formule dans le filtre avancé, en A2 surtout sans étiquette en A1 et choix de l'année par ailleurs en I2
Cordialement

jeanmi · 8 Décembre 2024

ALS35 à dit:
Bonjour de nouveau,
Alors tu peux faire avec une formule dans le filtre avancé, en A2 surtout sans étiquette en A1 et choix de l'année par ailleurs en I2
Cordialement

Re @ALS35 à tous,

Merci @ALS35 , c'est nickel.

Juste une petite question : si je selectionne l'année 2022 , la case A2 affiche VRAI, dans les autres cas FAUX

Cdlt

ALS35 · 8 Décembre 2024

Re,
Oui, parce que la formule est faite sur la première cellule de ta colonne date (A2) dont l'année est 2022.
(Note : on est là dans la partie avancée du filtre avancé !)
Cordialement

TooFatBoy · 8 Décembre 2024

jeanmi à dit:
Toutes mes excuses, mais pour moi le problème était posé correctement.

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim DateDeb As Long, DateFin As Long

    If Target.Address = "$A$2" Then
        Sheets("copie").Range("A5:K16").Clear
        DateDeb = DateSerial(Sheets("copie").Range("A2").Value, 1, 1)
        DateFin = DateSerial(Sheets("copie").Range("A2").Value, 12, 31)
        Sheets("base données").Range("A1:K37").AutoFilter Field:=1, Criteria1:=">=" & DateDeb, Operator:=xlAnd, Criteria2:="<=" & DateFin
        On Error Resume Next
        Sheets("base données").Range("A2:A37,I2:K37").SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("copie").Range("A5")
        Sheets("base données").Range("E2:G37").SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("copie").Range("E5")
        Sheets("base données").Range("A1:K37").AutoFilter
    End If

End Sub

jeanmi · 8 Décembre 2024

TooFatBoy à dit:

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim DateDeb As Long, DateFin As Long

    If Target.Address = "$A$2" Then
        Sheets("copie").Range("A5:K16").Clear
        DateDeb = DateSerial(Sheets("copie").Range("A2").Value, 1, 1)
        DateFin = DateSerial(Sheets("copie").Range("A2").Value, 12, 31)
        Sheets("base données").Range("A1:K37").AutoFilter Field:=1, Criteria1:=">=" & DateDeb, Operator:=xlAnd, Criteria2:="<=" & DateFin
        On Error Resume Next
        Sheets("base données").Range("A2:A37,I2:K37").SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("copie").Range("A5")
        Sheets("base données").Range("E2:G37").SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("copie").Range("E5")
        Sheets("base données").Range("A1:K37").AutoFilter
    End If

End Sub

Merci @TooFatBoy , je vais tester aussi cette solution.

Cordialement

jeanmi · 9 Décembre 2024

TooFatBoy à dit:

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim DateDeb As Long, DateFin As Long

    If Target.Address = "$A$2" Then
        Sheets("copie").Range("A5:K16").Clear
        DateDeb = DateSerial(Sheets("copie").Range("A2").Value, 1, 1)
        DateFin = DateSerial(Sheets("copie").Range("A2").Value, 12, 31)
        Sheets("base données").Range("A1:K37").AutoFilter Field:=1, Criteria1:=">=" & DateDeb, Operator:=xlAnd, Criteria2:="<=" & DateFin
        On Error Resume Next
        Sheets("base données").Range("A2:A37,I2:K37").SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("copie").Range("A5")
        Sheets("base données").Range("E2:G37").SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("copie").Range("E5")
        Sheets("base données").Range("A1:K37").AutoFilter
    End If

End Sub

Bonjour @TooFatBoy à tous

J’ai essayé de faire avec ton code dans mon programme et j’ai un petit problème que je n’arrive pas à résoudre :

Lorsque je fais la sélection de l’année sur la feuille « graph »

Les données sont donc filtrées à partir de la base de données « 2024-planetes » puis copier sur la feuille « les donnees pour graph » c'est ok.

Mais pour toutes les années de 2025 à xxxx, il reste toujours la date du 01/01/2024 sur la ligne 3 de la feuille « les donnees pour graph » donc mes graphiques ne sont pas bons.

Merci pour l’aide.

Cordialement

TooFatBoy · 9 Décembre 2024

La macro que je t'ai donnée n'est que du bricolage vite fait sur un coin de table, juste pour te montrer une façon possible de faire. Il faut l'adapter et surtout la peaufiner.

jeanmi à dit:
je n'arrive pas à poster le fichier, trop gros il semble

Pas besoin d'avoir 30 ans de données pour le débugage.

jeanmi · 9 Décembre 2024

TooFatBoy à dit:
La macro que je t'ai donnée n'est que du bricolage vite fait sur un coin de table, juste pour te montrer une façon possible de faire. Il faut l'adapter et surtout la peaufiner.

Pas besoin d'avoir 30 ans de données pour le débugage.

Merci pour l'info,
donc je laisse tomber cette macro n'étant pas en mesure de la faire fonctionner.

Cordialement

XL 2010 Utilisation filtre avancée en VBA

jeanmi

XLDnaute Occasionnel

Pièces jointes

ALS35

TooFatBoy

XLDnaute Barbatruc

jeanmi

XLDnaute Occasionnel

TooFatBoy

XLDnaute Barbatruc

ALS35

XLDnaute Impliqué

jeanmi

XLDnaute Occasionnel

jeanmi

XLDnaute Occasionnel

ALS35

XLDnaute Impliqué

Pièces jointes

jeanmi

XLDnaute Occasionnel

ALS35

XLDnaute Impliqué

TooFatBoy

XLDnaute Barbatruc

Pièces jointes

jeanmi

XLDnaute Occasionnel

jeanmi

XLDnaute Occasionnel

TooFatBoy

XLDnaute Barbatruc

jeanmi

XLDnaute Occasionnel

Discussions similaires