Problème filtre automatique avec vba

Version imprimable

21/07/2015, 13h17
aziz1015

Problème filtre automatique avec vba

Bonjour,

Grâce à joe.levrai et aux membres du forum j'ai beaucoup avancé sur mon projet mais je suis encore confronté à une autre difficulté malheureusement, je souhaite filtrer les dates du début de l'année en cours jusqu'au mois précédent, le code suivant fait un filtre uniquement sur le mois précédent :

Code:

Range("A1").AutoFilter c.Column, xlFilterThisMonth + 1, xlFilterDynamic

et celui ci sur l'année en cours :

Code:

Range("A1").AutoFilter c.Column, xlFilterThisYear, xlFilterDynamic

J'ai pensé à faire ça :

Code:

Range("A1").AutoFilter c.Column, xlFilterThisYear, xlAnd, xlFilterThisMonth + 1, xlFilterDynamic

Mais cela ne fonctionne pas :aie::?

Comment pourrais-je filtrer du début de l'année en cours au mois précédent, par exemple de Janvier à Juin, parce que nous sommes en Juillet. Est ce possible en appliquant les filtres dynamiques ?

Merci d'avance pour votre aide

Bonjour,

comme ça ?

Code:

1
2
3
4
5
6
7
8
9
Dim DateDebut As Date
Dim DateFin As Date
 
DateDebut = "01/01/" & Year(Date)
DateFin = "01/" & Month(Date) & "/" & Year(Date)
 
With Range("A1")
    .AutoFilter c.Column, ">=" & DateDebut, xlAnd, "<" & Format(DateFin, "mm/dd/yyyy")
End With

Bonjour a tous.
Ca fonctionnerait probablement mieux en utilisant un type Long ou Double :

Code:

1
2
3
4
5
dte = Year(Date)
 Dim debut As Long, fin As Long
    debut = DateSerial(dte, 1, 1)
    fin = DateSerial(dte, 6, 30)
    Range("A1").AutoFilter Field:=c.Column, Criteria1:=">=" & debut, Operator:=xlAnd, Criteria2:="<=" & fin

Avant tout, merci pour votre disponibilité.

Je vous présente mon code final qui fait le tri et par la suite le copie dans une autre feuille de calcul :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
 
 
Sub Creerfichier_reseauencourstarife2015()
 
Sheets("en cours liste complète réseau").Activate
Dim ListeTitre()
Dim ListeParam()
Dim DateDebut As Date
Dim DateFin As Date
 
DateDebut = "01/01/" & Year(Date)
DateFin = "01/" & Month(Date) & "/" & Year(Date)
 
ListeTitre = Array("Code_Delegation", "Statut_Etude", "Date_1ereTarification")
ListeParam = Array("<>DGEN*", Array("3", "4", "5", "6"))
 
 If Month(Now()) = 1 Then
    For i = LBound(ListeTitre) To UBound(ListeTitre)
        Set c = Nothing
        Set c = Rows(1).Find(ListeTitre(i), , xlValues, xlWhole)
        If Not c Is Nothing Then
            If i <= UBound(ListeParam) Then
               Range("A1").AutoFilter c.Column, ListeParam(i), xlFilterValues
           Else
                Range("A1").AutoFilter c.Column, xlFilterLastYear, xlFilterDynamic
            End If
        End If
    Next i
    ' on boucle sur chaque colonne cherchée
    ' et on filtre sur son paramètre dédié
  Else
    For i = LBound(ListeTitre) To UBound(ListeTitre)
        Set c = Nothing
        Set c = Rows(1).Find(ListeTitre(i), , xlValues, xlWhole)
        If Not c Is Nothing Then
            If i <= UBound(ListeParam) Then
                Range("A1").AutoFilter c.Column, ListeParam(i), xlFilterValues
            Else
                Range("A1").AutoFilter c.Column, ">=" & DateDebut, xlAnd, "<" & Format(DateFin, "mm/dd/yyyy")
            End If
        End If
    Next i
End If    
    Range(Range("A1"), Range("A1").SpecialCells(xlLastCell)).Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "réseau en cours tarifé 2015"
    ActiveSheet.Paste
    Application.CutCopyMode = False
 
End Sub

J'ai une erreur qui me dit impossible d'exécuter le code en mode arrêt lorsque je l’affecte à un bouton. Il fonctionne bien lorsque je l'exécute directement. Qu'est ce que ça veut dire ? Après analyse, l'erreur viendrait de ce bout de code :

Cordialement

21/07/2015, 15h48
joe.levrai

Salut Docmarti

ahhhh c'est certains de tes posts que je cherchais hier je pense ... ceux dans lesquels tu expliquais à la perfection les instructions les plus fiables pour les manipulations de dates entre VBA et Excel

je pensais que c'était Daniel.C :oops:
21/07/2015, 18h23
Docmarti

Salut joe.levrai

Je suis sensible à ton appréciation du résultat de mes recherches concernant les manipulations de dates entre VBA et Excel.

Ca a peut-être servi à quelque chose car les questions récurrentes à ce sujet sont devenues rarissimes.

Par contre, pour ce qui est des filtres, je n'en suis pas un des spécialistes.

Bonjour,
Je n'en finirai pas de dire les dates au format internationale

Code:

1
2
3
4
5
 
 Dim debut As string, fin As string 
    debut = ">" & Year(Date) -1 & "-12-31"
fin = "<" & format("yyyy-mm-01")
    Range("A1").AutoFilter Field:=c.Column, Criteria1:=  debut, Operator:=xlAnd, Criteria2:= fin

Bonjour,

désolé de revenir à la charge mais le filtre fait des erreurs lorsque le dernier mois précédent comporte 31 jours, j'ai ça :
Code:

1 2 3 4 5 6 mt = Month(Date) - 1 dte = Year(Date) Dim debut As Long, fin As Long debut = DateSerial(dte, 1, 1) fin = DateSerial(dte, mt, 30) Range("A1").AutoFilter Field:=c.Column, Criteria1:=">=" & debut, Operator:=xlAnd, Criteria2:="<=" & fin
j'ai essayé de faire toute sorte de modification comme ça par exemple:
Code:

1 2 3 4 5 6 dte = Year(Date) mt = Month(Year) - 1 Dim debut As Long, fin As Long debut = DateSerial(dte, 1, 1) fin = DateSerial(dte, mt, 31) Range("A1").AutoFilter Field:=c.Column, Criteria1:=">=" & debut, Operator:=xlAnd, Criteria2:="<=" & fin
Mais dans ce cas, il prend bien le 31 du mois précédent mais il prend en compte le 1er du mois en cours dans le filtre, ce que je ne veux pas, je ne sais pas quoi faire. Par contre, je n'ai aucun problème avec la solution proposée par joe.levrai.

Merci à tous les deux

Merci d'avance pour votre aide

22/07/2015, 12h32
joe.levrai

Bonjour,

comme abordé sur nos échanges (avec rdurupt et Docmarti), ma proposition n'est pas universelle, en ce sens où dans certains cas on "pourrait" avoir une inversion entre les mois et les jours.

cependant, dans ton contexte, ce problème ne devrait pas se rencontrer.

En effet, comme on ne manipulait que le mois (et pas le jour qui est toujours "01"), en formatant "mm/dd/yyyy" on ne provoque pas de mélange des genres quand on bascule entre la tranche "du 1er au 12 du mois" et la tranche "du 13 jusqu'au dernier jour"

je suis un peu pressé, pas le temps de te proposer une adaptation de Docmarti (qu'il te fournira probablement s'il revient avant moi)
as-tu également testé la solution de rdurupt ?
22/07/2015, 12h58
Invité

Bonjour,
@Joe: Dans la mesure ou on concatène la date avec l'opérateur,on converti en string donc il y a risque d'inversion Criteria1:=">=" & debut!
La mayeur façons de connaitre le dernier jour du mois précédent est
fin =Format( Cdate(format (date,"yyyy-mm-01")) - 1,"yyyy-mm-dd")
22/07/2015, 13h09
joe.levrai

Oui tu as tout à fait raison.

Je parlais uniquement de ma proposition et de son contexte.

Ma DateDebut c'est "01/01" et l'année

Si VBA veut inverser, qu'il le fasse, ça change rien :ptdr:

Et ça ne change également rien au fait qu'il faut que je révise et utilise sérieusement vos formats (toi et Docmarti) pour enfin systématiser cet utilisation dans mes codes :aie:
22/07/2015, 13h40
Invité

Oui Joe tu as raison, mais je me dis que tout ça pour faire un copier coller, c'est beaucoup de travail pour rien car un filtre avancé ou élaboré ferait largement l'affaire!

si notre amis veut bien nous fournir un fichier avec des données bidonnées, je me ferai une joie de lui fournir un source!

Je sais Joe ça déroge à nos accords passé qui veut que c'est toi qui code!
:king::mouarf3: Mais j'ai bien compris que tu avais quelque déboires et que ton temps était compté!

1 pièce(s) jointe(s)

Bonjour,

En fait mon but étant d'automatiser cela, je ne vois pas comment le faire sachant que la feuille Excel pourrait contenir des milliers de ligne, une boucle For prendrait beaucoup trop de temps en mon sens. J'avais utilisé l'enregistreur de macros en faisant un filtre avancé au départ mais le filtre n'était pas correct. Si vous avez une meilleure solution que le filtre et le copier-coller, je suis preneur. 8-)

mon code ci-dessous :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Sub Creerfeuille_reseauencourstarife2015()
 
Sheets("en cours liste complète réseau").Activate
 
'dte = Year(Date)
'mt = Month(Date) - 1
' Dim debut As Long, fin As Long
'    debut = DateSerial(dte, 1, 1)
'    fin = DateSerial(dte, mt, 30)
 
 
Dim ListeTitre()
Dim ListeParam()
 
Dim DateDebut As Date
Dim DateFin As Date
 
DateDebut = "01/01/" & Year(Date)
DateFin = "01/" & Month(Date) & "/" & Year(Date)
 
ListeTitre = Array("Code_Delegation", "Statut_Etude", "Date_1ereTarification")
ListeParam = Array("<>DGEN*", Array("3", "4", "5", "6"))
 
 If Month(Now()) = 1 Then
    For i = LBound(ListeTitre) To UBound(ListeTitre)
        Set c = Nothing
        Set c = Rows(1).Find(ListeTitre(i), , xlValues, xlWhole)
        If Not c Is Nothing Then
            If i <= UBound(ListeParam) Then
               Range("A1").AutoFilter c.Column, ListeParam(i), xlFilterValues
            Else
                Range("A1").AutoFilter c.Column, xlFilterLastYear, xlFilterDynamic
            End If
         End If
     Next i
    ' on boucle sur chaque colonne cherchée
    ' et on filtre sur son paramètre dédié
  Else
    For i = LBound(ListeTitre) To UBound(ListeTitre)
        Set c = Nothing
        Set c = Rows(1).Find(ListeTitre(i), , xlValues, xlWhole)
        If Not c Is Nothing Then
            If i <= UBound(ListeParam) Then
                Range("A1").AutoFilter c.Column, ListeParam(i), xlFilterValues
            Else
                Range("A1").AutoFilter c.Column, ">=" & DateDebut, xlAnd, "<" & Format(DateFin, "mm/dd/yyyy")
            End If
        End If
     Next i
  End If
 
    Range(Range("A1"), Range("A1").SpecialCells(xlLastCell)).Copy
    Sheets.Add After:=Sheets("en cours liste complète réseau")
    ActiveSheet.Name = "réseau en cours tarifé 2015"
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets("en cours liste complète réseau").Select
    Selection.AutoFilter
 
 
End Sub

Cordialement

22/07/2015, 15h14
joe.levrai

+1 pour le filtre avancé

j'avoue ne pas avoir lu la suite du code, au sujet de la copie et compagnie :oops:

vas-y rdurupt, c'est toi qui a gagné au loto, je te laisse préparer le filtre avancé :P

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Sub Test()
Dim WsSOurce As Worksheet, filtre As Workbook, WsCible As Worksheet
Dim Dab As String, Fin As String
Set WsSOurce = ThisWorkbook.Sheets("Feuil1")
On Error Resume Next: WsSOurce.ShowAllData: On Error GoTo 0
Set WsCible = ThisWorkbook.Sheets.Add(After:=WsSOurce)
 WsCible.Name = "réseau en cours tarifé " & Year(Date)
deb = ">" & Year(Date) - 1 & "-12-31"
Fin = "<" & Format(Date, "yyyy-mm-01")
Set filtre = Workbooks.Add
filtre.Sheets(1).Range("A1") = "Das"
filtre.Sheets(1).Range("B1") = "Date_1ereTarification"
filtre.Sheets(1).Range("C1") = "Date_DemandeSouscription"
filtre.Sheets(1).Range("D1") = "Statut_Etude"
filtre.Sheets(1).Range("E1") = "Statut_Etude"
 
filtre.Sheets(1).Range("A2") = "SANTE"
filtre.Sheets(1).Range("B2") = deb
filtre.Sheets(1).Range("C2") = Fin
filtre.Sheets(1).Range("D2") = ">2"
filtre.Sheets(1).Range("E2") = "<7"
FiltreActif WsSOurce.UsedRange, filtre.Sheets(1).UsedRange, WsCible.Range("A1")
filtre.Close False
Set filtre = Nothing
End Sub
Function FiltreActif(RangeSource As Range, CriterRange As Range, CopyRange As Range, Optional Unique As Boolean = True) As Boolean
FiltreActif = False
On Error Resume Next
 RangeSource.AdvancedFilter Action:= _
        xlFilterCopy, CriteriaRange:=CriterRange _
        , CopyToRange:=CopyRange, Unique:=Unique
        DoEvents
        If Err = 0 Then FiltreActif = True
        'MsgBox Err.Description
        On Error GoTo 0
End Function

Citation:
Envoyé par aziz1015
Bonjour,

désolé de revenir à la charge mais le filtre fait des erreurs lorsque le dernier mois précédent comporte 31 jours, j'ai ça :
Code:

1 2 3 4 5 6 7 mt = Month(Date) - 1 dte = Year(Date) Dim debut As Long, fin As Long debut = DateSerial(dte, 1, 1) fin = DateSerial(dte, mt, 30) Range("A1").AutoFilter Field:=c.Column, Criteria1:=">=" & debut, Operator:=xlAnd, Criteria2:="<=" & fin
j'ai essayé de faire toute sorte de modification comme ça par exemple:
Code:

1 2 3 4 5 6 7 8 dte = Year(Date) mt = Month(Year) - 1 Dim debut As Long, fin As Long debut = DateSerial(dte, 1, 1) fin = DateSerial(dte, mt, 31) Range("A1").AutoFilter Field:=c.Column, Criteria1:=">=" & debut, Operator:=xlAnd, Criteria2:="<=" & fin
Mais dans ce cas, il prend bien le 31 du mois précédent mais il prend en compte le 1er du mois en cours dans le filtre, ce que je ne veux pas, je ne sais pas quoi faire. Par contre, je n'ai aucun problème avec la solution proposée par joe.levrai.

Merci à tous les deux

Merci d'avance pour votre aide
Désolé. J'avais mis n'importe quoi pour illustrer Dim debut As Long, fin As Long.

Dans ton cas, le code serait :
Code:

1 2 3 4 5 6 dte = Year(Date) mt = Month(Date) Dim debut As Long, fin As Long debut = DateSerial(dte, 1, 1) fin = DateSerial(dte, mt, 1) Range("A1").AutoFilter Field:=c.Column, Criteria1:=">=" & debut, Operator:=xlAnd, Criteria2:="<" & fin

Citation:

Envoyé par rdurupt

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Sub Test()
Dim WsSOurce As Worksheet, filtre As Workbook, WsCible As Worksheet
Dim Dab As String, Fin As String
Set WsSOurce = ThisWorkbook.Sheets("Feuil1")
On Error Resume Next: WsSOurce.ShowAllData: On Error GoTo 0
Set WsCible = ThisWorkbook.Sheets.Add(After:=WsSOurce)
 WsCible.Name = "réseau en cours tarifé " & Year(Date)
deb = ">" & Year(Date) - 1 & "-12-31"
Fin = "<" & Format(Date, "yyyy-mm-01")
Set filtre = Workbooks.Add
filtre.Sheets(1).Range("A1") = "Das"
filtre.Sheets(1).Range("B1") = "Date_1ereTarification"
filtre.Sheets(1).Range("C1") = "Date_DemandeSouscription"
filtre.Sheets(1).Range("D1") = "Statut_Etude"
filtre.Sheets(1).Range("E1") = "Statut_Etude"
 
filtre.Sheets(1).Range("A2") = "SANTE"
filtre.Sheets(1).Range("B2") = deb
filtre.Sheets(1).Range("C2") = Fin
filtre.Sheets(1).Range("D2") = ">2"
filtre.Sheets(1).Range("E2") = "<7"
FiltreActif WsSOurce.UsedRange, filtre.Sheets(1).UsedRange, WsCible.Range("A1")
filtre.Close False
Set filtre = Nothing
End Sub
Function FiltreActif(RangeSource As Range, CriterRange As Range, CopyRange As Range, Optional Unique As Boolean = True) As Boolean
FiltreActif = False
On Error Resume Next
 RangeSource.AdvancedFilter Action:= _
        xlFilterCopy, CriteriaRange:=CriterRange _
        , CopyToRange:=CopyRange, Unique:=Unique
        DoEvents
        If Err = 0 Then FiltreActif = True
        'MsgBox Err.Description
        On Error GoTo 0
End Function

Merci infiniment pour ce code mais je ne comprends pas vraiment ce que la onction FiltreActif fait !

22/07/2015, 16h48
Invité

Il copie dans le nouvel onglet le données filtrées sur les mêmes critères que le filtre que tu faisais précédemment!
22/07/2015, 16h52
aziz1015

Merci