XL 2010 Utilisation filtre avancée en VBA

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

  • essai-v1.xlsm
    22.7 KB · Affichages: 6

TooFatBoy

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

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

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

jeanmi

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

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

TooFatBoy

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

  • essai-v1.xlsm
    28.5 KB · Affichages: 7

jeanmi

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

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

jeanmi

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

Discussions similaires

Réponses
5
Affichages
731

Statistiques des forums

Discussions
315 084
Messages
2 116 060
Membres
112 645
dernier inscrit
Acid Burn