XL 2010 Utilisation filtre avancée en VBA

  • Initiateur de la discussion Initiateur de la discussion jeanmi
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

jeanmi

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

Pièces jointes

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,

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


Que faut-il faire ?
Poser le problème correctement dès le début pour éviter de tout refaire plusieurs fois.


Bon dimanche
 
É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
 
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
 
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
 

Pièces jointes

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
 
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
 
Dernière édition:
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
2
Affichages
534
Retour