Problème filtre automatique avec vba

**aziz1015** · 21/07/2015, 13h17

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

J'ai pensé à faire ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Mais cela ne fonctionne pas

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

**joe.levrai** · 21/07/2015, 14h35

Bonjour,

comme ça ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Docmarti** · 21/07/2015, 15h05

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**aziz1015** · 21/07/2015, 15h23

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**joe.levrai** · 21/07/2015, 15h48

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

**Docmarti** · 21/07/2015, 18h23

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.

Invité · 21/07/2015, 19h42

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**aziz1015** · 22/07/2015, 11h38

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**joe.levrai** · 22/07/2015, 12h32

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 ?

Invité · 22/07/2015, 12h58

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")

**joe.levrai** · 22/07/2015, 13h09

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

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

Invité · 22/07/2015, 13h40

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!

Mais j'ai bien compris que tu avais quelque déboires et que ton temps était compté!

**aziz1015** · 22/07/2015, 14h28

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.

mon code ci-dessous :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**joe.levrai** · 22/07/2015, 15h14

+1 pour le filtre avancé

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

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

Invité · 22/07/2015, 15h22

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Docmarti** · 22/07/2015, 15h48

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**aziz1015** · 22/07/2015, 16h37

Envoyé par rdurupt

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 !