Filtre sur date

tithom_82

5 Novembre 2012 11:36:14

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.

Autres pages sur : filtre date

tithom_82 a édité ce message 5 Novembre 2012 11:40:07

| Etre averti des réponses
| Alerter

tithom_82

5 Novembre 2012 12:38:01

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... :pt1cable:

j'ai également vu la commande CDate, faut il passer par la.... mais même avec ça, ça ne fonctionne pas..

| Alerter

tithom_82

5 Novembre 2012 14:54:53

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

tithom_82 a édité ce message 5 Novembre 2012 15:03:43
tithom_82 a édité ce message 5 Novembre 2012 14:57:08

| Alerter

zeb

6 Novembre 2012 09:31:08

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)

| Alerter

tithom_82

6 Novembre 2012 09:38:39

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 a édité ce message 6 Novembre 2012 09:57:18

| Alerter

tithom_82

6 Novembre 2012 17:05:33

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?? :pt1cable:

tithom_82 a édité ce message 6 Novembre 2012 17:48:04
tithom_82 a édité ce message 6 Novembre 2012 17:43:34

| Alerter

zeb

9 Novembre 2012 10:00:32

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

| Alerter

tithom_82

12 Novembre 2012 22:14:22

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:

| Alerter

zeb

13 Novembre 2012 11:57:27

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

Étudie-le bien

| Alerter

tithom_82

13 Novembre 2012 18:29:54

zeb a dit :

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.... :pt1cable:

| Alerter