Filtre sur date

[tithom_82]

Bonjour,

je suis sur un nouveau problème! (sinon je ne serai pas là! )
Alors voila, je dois réaliser une macro qui permet de compter le nombre d'intervention dans le mois. Je pars d'un fichier qui regroupe toutes les interventions de l'année. Pour cela dans ma feuille 2, la date est sous forme dd/mm/yy hh:mm. le fichier est une extraction d'un autre logiciel. Les différentes infos que j'ai récolté sur le net, mon filtre auto ne marche pas.

et la je sèche complètement....
voila ce que j'ai fait:

Option Explicit
Sub filtre()
'
' filtre Macro
'
Dim f_avis As Worksheet
Dim LastLine As Long
Dim d As String



Set f_avis = Worksheets("Feuil2")

'on désactive les filtres existants
Worksheets("Feuil2").AutoFilterMode = False

'on demande la date (je veux en fait filtrer sur un 1 mois)
d = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date du filtre")



'ou se trouve la derniere ligne?
LastLine = WorksheetFunction.Max(f_avis.Cells(f_avis.Rows.Count, "F").End(xlUp).Row)
'
   
'on applique le filtre auto
   With f_avis
Range("A5").AutoFilter Field:=2, Criteria2:="d" 'on commence à la ligne 5 sur la colonne 2 en recherchant la valeur 
End With
  

'on affiche les valeurs (pour le test)
MsgBox d  & "  " & LastLine

End Sub

quand je lance la macro, le filtre se lance correctement mais aucune donnée, et quand on passe la souris sur le filtre de la colonne 2, il me met "d" et non la date rentrée dans l'input box. Ya -t'il un moyen de faire comme dans la liste déroulante du filtre, c'est-a-dire, de choisir le mois de septembre par exemple?
avez-vous une idée??
A mon avis c'est 28 29 30 qui merdouille...
Merci d'avance.

 

[tithom_82]

j'ai fait un test sur date début et fin:

même résultat:

Option Explicit
Sub filtre()
'
' filtre Macro
'
Dim f_avis As Worksheet
Dim Cell As Variant
Dim LastLine As Long
Dim d As String
Dim d2 As String


Set f_avis = Worksheets("Feuil2")

'on désactive les filtres existants
Worksheets("Feuil2").AutoFilterMode = False

'on demande la date (je veux en fait filtrer sur un 1 mois)
d = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date de début")
d2 = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date de fin")


'ou se trouve la derniere ligne?
LastLine = WorksheetFunction.Max(f_avis.Cells(f_avis.Rows.Count, "F").End(xlUp).Row)
'
   
'on applique le filtre auto
   With f_avis
Range("A5").AutoFilter Field:=2, Criteria1:="d", Operator:=xlAnd, Criteria2:="d2"
End With
  

'on affiche les valeurs (pour le test)
MsgBox d & "  " & d2 & "  " & LastLine

End Sub

J'ai fait le test avec un colonne en mettant des 1 un peu partout, et pareil en filtrant sur 1 dans cette même colonne ça ne fonctionne pas... t1cable:

j'ai également vu la commande

Vous devez être connecté pour voir les liens.

, faut il passer par la.... mais même avec ça, ça ne fonctionne pas..

 

[tithom_82]

encore moi....

j'ai fait d'autres essais avec l'enregistreur de macro, ca me fait un truc dégu*£*$* mais .. ça fonctionne...
Par contre pour mettre la date avec une intput box..impossible! ca doit etre le type qu'il n'aime pas... ou pas:??:

Option Explicit
Sub filtre()
'
' filtre Macro
'
Dim f_avis As Worksheet
Dim LastLine As Long
Dim d As String
Dim snc As Integer
Dim ATSR As Integer
Dim total As Integer




Set f_avis = Worksheets("Feuil2")

'on désactive les filtres existants
Worksheets("Feuil2").AutoFilterMode = False

'on demande la date (je veux en fait filtrer sur un 1 mois)
d = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date")


'ou se trouve la dernière ligne?
LastLine = WorksheetFunction.Max(f_avis.Cells(f_avis.Rows.Count, "F").End(xlUp).Row)


'on filtre sur le mois d'octobre
 f_avis.Range("$A$5:$H$500").AutoFilter Field:=2, Operator:= _
        xlFilterValues, Criteria2:=Array(1, "d")

' on compte pour SNC
 f_avis.Rows("5:5").Select
 f_avis.Range("B5").Activate
 f_avis.Range("$A$5:$H$500").AutoFilter Field:=4, Criteria1:="=*SNC*", _
        Operator:=xlAnd
   
snc = f_avis.AutoFilter.Range.Columns(4).SpecialCells(xlCellTypeVisible).Cells.Count
   
'on compte pour ATSR

 f_avis.Range("$A$5:$H$500").AutoFilter Field:=4, Criteria1:="=*ATSR*", _
        Operator:=xlAnd
     
 ATSR = f_avis.AutoFilter.Range.Columns(4).SpecialCells(xlCellTypeVisible).Cells.Count
 
 
total = snc + ATSR

'on affiche les valeurs (pour le test)
MsgBox snc & "  " & ATSR & "  " & total

End Sub

ligne 30 31: ereur 1004: la méthode Autofilter de la classe range à échoué
par contre si à la ligne 31 je mets:

xlFilterValues, Criteria2:=Array(1, "10/31/2012")

la ça fonctionne...

si on met d as Date, ce ne marche pas non plus
je cherche encore...

 

[zeb]

Salut,

Je ne sais pas trop où est ton problème, mais étudie un peu ce petit morceau de code :

Dim libelle As String
Dim s       As String
Dim d       As Date

libelle = "Une date, s'il vous plaît."
Do
    s = InputBox(libelle, "Date")
    libelle = "Une vraie date, s'il vous plaît."
Loop While Not IsDate(s)
d = CDate(s)

 

[tithom_82]

salut Zeb, merci de ta réponse je vais me pencher sur ta proposition.
Hier j'ai fait ca également sans trop de résultat...

Dim d1 As String
Dim d2 As String
Dim d1_bis As Date
Dim d2_bis As Date

'on demande la date (je veux en fait filtrer sur un 1 mois)
d1 = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date de début")
d2 = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date de fin")
d1_bis = Format(d1, "GENERAL date")
d2_bis = Format(d2, "GENERAL date")


'on filtre sur le mois 
    f_avis.Range("$A$5:$H" & LastLine).AutoFilter field:=2, Criteria1:=">=" & d1_bis, Operator:=xlAnd, Criteria2:="<=" & d2_bis  '

Mon problème est que, avec ta solution ou un autre, je ne trouve pas le moyen de faire un filtre automatique sur le mois entier (rentrer dans le libelle ou une inputbox)--> j'ai un retour nul ( pas de données après l'application du filtre)

 

[tithom_82]

salut zeb,

j'ai changé de méthodes et la ca fonctionne. ma colonne B ou ce trouve les dates est de forme dd/mm/yyy hh:mm j'ai dans ma macro changé la date dd/mm/yyyy en Month(). je me suis inspiré d'une des macro ou tu as largement participé et j'ai ceci:

 Option Explicit
 
Sub RechercherNom()
 
Dim TheName As String
Dim F As Worksheet
Dim R As Range
Dim FirstFound As String
Dim tot As String
Dim d As String
Dim madate As Date
Dim Plg As Range
Dim LastLine As Long


Set F = Worksheets("Feuil2")

'ou se trouve la derniere ligne?
LastLine = WorksheetFunction.Max(F.Cells(F.Rows.Count, "F").End(xlUp).Row)

tot = 0

d = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date")
madate = CDate(d)

TheName = InputBox("Entrez le Nom de l'équipement :", "Nom")
 
Set Plg = F.Range(F.Cells(5, 4), F.Cells(LastLine, 4))
 
With Plg
 
    Set R = .Find(TheName, LookIn:=xlValues, LookAt:=xlPart)
        If Not (R Is Nothing) Then
            FirstFound = R.Address
            Do
                Set R = .FindNext(R)
                If Month(R.Offset(0, -2)) = Month(madate) Then
                tot = tot + 1
                End If
            Loop While R.Address <> FirstFound
               
        Else
            MsgBox ("Ce nom n'est pas répertorié")
 
        End If
 
End With

 MsgBox tot & "  " & LastLine
 
 
End Sub

Ma prochaine étape est de refaire avec différents Thename (sachant qu'ils sont tous fixes), il faut passer par un tableau je suppose: du type

Dim tab_equip(9) As Variant

tab_equip(0) = "snc"
tab_equip(1) = "atsr"
tab_equip(2) = "tsn"
tab_equip(3) = "planar"
tab_equip(4) = "pee"
tab_equip(5) = "eh"
tab_equip(6) = "sas"
tab_equip(7) = "sts"
tab_equip(8) = "1000"
tab_equip(9) = "coris"

Un truc du genre pourrait marcher??

for tab_equip()  in plg
Set R = .Find(tab_equip(), LookIn:=xlValues, LookAt:=xlPart)
        If Not (R Is Nothing) Then
            FirstFound = R.Address
            Do
                Set R = .FindNext(R)
                If Month(R.Offset(0, -2)) = Month(madate) Then
                tot = tot + 1
                End If
            Loop While R.Address <> FirstFound
               
        Else
            MsgBox ("Ce nom n'est pas répertorié")
 
        End If
 
End With
next tab_equip()

mais comment faire pour séparer les tot par un différent nom à chaque fois?? t1cable:

 

[zeb]

Plop,

Dim Erreurs as String
Dim i       as Integer

For i = LBound(tab_equip) To UBound(tab_equip)
	Set R = Plg.Find(tab_equip(i), LookIn:=xlValues, LookAt:=xlPart)
	If Not R Is Nothing Then
		FirstFound = R.Address
		Do
			If Month(R.Offset(0, -2)) = Month(madate) Then tot = tot + 1
			Set R = Plg.FindNext(R)
		Loop While Not R Is Nothing And R.Address <> FirstFound
	Else
		Erreurs = Erreurs & """" & tab_equip(i) & """" & " n'est pas répertorié."
	End If
Next
MsgBox Erreurs

 

[tithom_82]

Yop Zeb,

merci pour le bout de code, pour le moment il ne marche pas... ou alors il me sort que ce qu'il n'y a pas ...
Mais je cherche, je cherche!! :chaudar:

 

[zeb]

M'enfin, j'avais fait des commentaires pour accompagner le bout de code que je proposais.
Ont-ils été oubliés ? :/

Étudie-le bien

 

[tithom_82]

M'enfin, j'avais fait des commentaires pour accompagner le bout de code que je proposais.
Ont-ils été oubliés ? :/

Étudie-le bien

Re...
effectivement je n'ai pas lu les interlignes!!

Sinon j'ai un truc qui marche

Option Explicit
Sub indicateur()

'déclaration des variables
Dim TheName As String
Dim F As Worksheet
Dim R As Range
Dim FirstFound As String
Dim d As String
Dim madate As Date
Dim Plg As Range
Dim LastLine As Long
Dim tab_equip(9) As Variant
Dim tab_total(9) As Variant
Dim cell As Variant
Dim Erreurs As String
Dim ligne As String
Dim total As Integer
Dim i As Integer
Dim J As Integer

'définition des variables
Set F = Worksheets("Feuil2")

tab_equip(0) = "snc"
tab_equip(1) = "atsr"
tab_equip(2) = "tsn"
tab_equip(3) = "planar"
tab_equip(4) = "pee"
tab_equip(5) = "eh"
tab_equip(6) = "sas"
tab_equip(7) = "sts"
tab_equip(8) = "1000"
tab_equip(9) = "coris"

'on désactive les filtres existants
Worksheets("Feuil2").AutoFilterMode = False

'ou se trouve la derniere ligne?
LastLine = WorksheetFunction.Max(F.Cells(F.Rows.Count, "F").End(xlUp).Row)

'on supprime les commentaires de la colonne description pour garder les num d'avis
For Each cell In F.Range("E5:E" & LastLine)
        cell.Formula = Mid(cell.Formula, 1, 15)
Next



i = 0
Erreurs = ""
total = 0

Do
    d = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "Date")
    
Loop While Not IsDate(d)
madate = CDate(d)


Set Plg = F.Range(F.Cells(5, 4), F.Cells(LastLine, 4))
        For i = LBound(tab_equip) To UBound(tab_equip)
            Set R = Plg.Find(tab_equip(i), LookIn:=xlValues, LookAt:=xlPart)
        If Not R Is Nothing Then
            FirstFound = R.Address
    Do
        If Month(R.Offset(0, -2)) = Month(madate) Then tab_total(i) = tab_total(i) + 1
        Set R = Plg.FindNext(R)
        
Loop While Not R Is Nothing And R.Address <> FirstFound
Else
        Erreurs = Erreurs & """" & tab_equip(i) & """" & " n'est pas répertorié."
End If
Next
    
For i = 0 To 9
    total = total + tab_total(i)
    ligne = ligne & tab_equip(i) & Chr(9) & tab_total(i) & Chr(13)
Next i

MsgBox ligne & "nombre d'intervention ADN:  " & total
   
End Sub

par contre j'ai toujours mon problème de filtre sur madate.... t1cable: