Se connecter avec
S'enregistrer | Connectez-vous
Votre question

Filtre sur date

Tags :
  • probleme
  • Programmation
Dernière réponse : dans Programmation
Partagez
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:

  1. Option Explicit
  2. Sub filtre()
  3. '
  4. ' filtre Macro
  5. '
  6. Dim f_avis As Worksheet
  7. Dim LastLine As Long
  8. Dim d As String
  9.  
  10.  
  11.  
  12. Set f_avis = Worksheets("Feuil2")
  13.  
  14. 'on désactive les filtres existants
  15. Worksheets("Feuil2").AutoFilterMode = False
  16.  
  17. 'on demande la date (je veux en fait filtrer sur un 1 mois)
  18. d = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date du filtre")
  19.  
  20.  
  21.  
  22. 'ou se trouve la derniere ligne?
  23. LastLine = WorksheetFunction.Max(f_avis.Cells(f_avis.Rows.Count, "F").End(xlUp).Row)
  24. '
  25.  
  26. 'on applique le filtre auto
  27. With f_avis
  28. Range("A5").AutoFilter Field:=2, Criteria2:="d" 'on commence à la ligne 5 sur la colonne 2 en recherchant la valeur
  29. End With
  30.  
  31.  
  32. 'on affiche les valeurs (pour le test)
  33. MsgBox d & " " & LastLine
  34.  
  35. 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

5 Novembre 2012 12:38:01

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

même résultat:

  1. Option Explicit
  2. Sub filtre()
  3. '
  4. ' filtre Macro
  5. '
  6. Dim f_avis As Worksheet
  7. Dim Cell As Variant
  8. Dim LastLine As Long
  9. Dim d As String
  10. Dim d2 As String
  11.  
  12.  
  13. Set f_avis = Worksheets("Feuil2")
  14.  
  15. 'on désactive les filtres existants
  16. Worksheets("Feuil2").AutoFilterMode = False
  17.  
  18. 'on demande la date (je veux en fait filtrer sur un 1 mois)
  19. d = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date de début")
  20. d2 = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date de fin")
  21.  
  22.  
  23. 'ou se trouve la derniere ligne?
  24. LastLine = WorksheetFunction.Max(f_avis.Cells(f_avis.Rows.Count, "F").End(xlUp).Row)
  25. '
  26.  
  27. 'on applique le filtre auto
  28. With f_avis
  29. Range("A5").AutoFilter Field:=2, Criteria1:="d", Operator:=xlAnd, Criteria2:="d2"
  30. End With
  31.  
  32.  
  33. 'on affiche les valeurs (pour le test)
  34. MsgBox d & " " & d2 & " " & LastLine
  35.  
  36. 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..
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:??: 

  1. Option Explicit
  2. Sub filtre()
  3. '
  4. ' filtre Macro
  5. '
  6. Dim f_avis As Worksheet
  7. Dim LastLine As Long
  8. Dim d As String
  9. Dim snc As Integer
  10. Dim ATSR As Integer
  11. Dim total As Integer
  12.  
  13.  
  14.  
  15.  
  16. Set f_avis = Worksheets("Feuil2")
  17.  
  18. 'on désactive les filtres existants
  19. Worksheets("Feuil2").AutoFilterMode = False
  20.  
  21. 'on demande la date (je veux en fait filtrer sur un 1 mois)
  22. d = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date")
  23.  
  24.  
  25. 'ou se trouve la dernière ligne?
  26. LastLine = WorksheetFunction.Max(f_avis.Cells(f_avis.Rows.Count, "F").End(xlUp).Row)
  27.  
  28.  
  29. 'on filtre sur le mois d'octobre
  30. f_avis.Range("$A$5:$H$500").AutoFilter Field:=2, Operator:= _
  31. xlFilterValues, Criteria2:=Array(1, "d")
  32.  
  33. ' on compte pour SNC
  34. f_avis.Rows("5:5").Select
  35. f_avis.Range("B5").Activate
  36. f_avis.Range("$A$5:$H$500").AutoFilter Field:=4, Criteria1:="=*SNC*", _
  37. Operator:=xlAnd
  38.  
  39. snc = f_avis.AutoFilter.Range.Columns(4).SpecialCells(xlCellTypeVisible).Cells.Count
  40.  
  41. 'on compte pour ATSR
  42.  
  43. f_avis.Range("$A$5:$H$500").AutoFilter Field:=4, Criteria1:="=*ATSR*", _
  44. Operator:=xlAnd
  45.  
  46. ATSR = f_avis.AutoFilter.Range.Columns(4).SpecialCells(xlCellTypeVisible).Cells.Count
  47.  
  48.  
  49. total = snc + ATSR
  50.  
  51. 'on affiche les valeurs (pour le test)
  52. MsgBox snc & " " & ATSR & " " & total
  53.  
  54. End Sub



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

  1. 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...
Contenus similaires
a b L Programmation
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 :
  1. Dim libelle As String
  2. Dim s As String
  3. Dim d As Date
  4.  
  5. libelle = "Une date, s'il vous plaît."
  6. Do
  7. s = InputBox(libelle, "Date")
  8. libelle = "Une vraie date, s'il vous plaît."
  9. Loop While Not IsDate(s)
  10. d = CDate(s)
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...

  1. Dim d1 As String
  2. Dim d2 As String
  3. Dim d1_bis As Date
  4. Dim d2_bis As Date
  5.  
  6. 'on demande la date (je veux en fait filtrer sur un 1 mois)
  7. d1 = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date de début")
  8. d2 = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date de fin")
  9. d1_bis = Format(d1, "GENERAL date")
  10. d2_bis = Format(d2, "GENERAL date")
  11.  
  12.  
  13. 'on filtre sur le mois
  14. 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)
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:

  1. Option Explicit
  2.  
  3. Sub RechercherNom()
  4.  
  5. Dim TheName As String
  6. Dim F As Worksheet
  7. Dim R As Range
  8. Dim FirstFound As String
  9. Dim tot As String
  10. Dim d As String
  11. Dim madate As Date
  12. Dim Plg As Range
  13. Dim LastLine As Long
  14.  
  15.  
  16. Set F = Worksheets("Feuil2")
  17.  
  18. 'ou se trouve la derniere ligne?
  19. LastLine = WorksheetFunction.Max(F.Cells(F.Rows.Count, "F").End(xlUp).Row)
  20.  
  21. tot = 0
  22.  
  23. d = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date")
  24. madate = CDate(d)
  25.  
  26. TheName = InputBox("Entrez le Nom de l'équipement :", "Nom")
  27.  
  28. Set Plg = F.Range(F.Cells(5, 4), F.Cells(LastLine, 4))
  29.  
  30. With Plg
  31.  
  32. Set R = .Find(TheName, LookIn:=xlValues, LookAt:=xlPart)
  33. If Not (R Is Nothing) Then
  34. FirstFound = R.Address
  35. Do
  36. Set R = .FindNext(R)
  37. If Month(R.Offset(0, -2)) = Month(madate) Then
  38. tot = tot + 1
  39. End If
  40. Loop While R.Address <> FirstFound
  41.  
  42. Else
  43. MsgBox ("Ce nom n'est pas répertorié")
  44.  
  45. End If
  46.  
  47. End With
  48.  
  49. MsgBox tot & " " & LastLine
  50.  
  51.  
  52. 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
  1. Dim tab_equip(9) As Variant
  2.  
  3. tab_equip(0) = "snc"
  4. tab_equip(1) = "atsr"
  5. tab_equip(2) = "tsn"
  6. tab_equip(3) = "planar"
  7. tab_equip(4) = "pee"
  8. tab_equip(5) = "eh"
  9. tab_equip(6) = "sas"
  10. tab_equip(7) = "sts"
  11. tab_equip(8) = "1000"
  12. tab_equip(9) = "coris"


Un truc du genre pourrait marcher??
  1. for tab_equip() in plg
  2. Set R = .Find(tab_equip(), LookIn:=xlValues, LookAt:=xlPart)
  3. If Not (R Is Nothing) Then
  4. FirstFound = R.Address
  5. Do
  6. Set R = .FindNext(R)
  7. If Month(R.Offset(0, -2)) = Month(madate) Then
  8. tot = tot + 1
  9. End If
  10. Loop While R.Address <> FirstFound
  11.  
  12. Else
  13. MsgBox ("Ce nom n'est pas répertorié")
  14.  
  15. End If
  16.  
  17. End With
  18. next tab_equip()


mais comment faire pour séparer les tot par un différent nom à chaque fois?? :pt1cable: 
a b L Programmation
9 Novembre 2012 10:00:32

Plop,

  1. Dim Erreurs as String
  2. Dim i as Integer
  3.  
  4. For i = LBound(tab_equip) To UBound(tab_equip)
  5. Set R = Plg.Find(tab_equip(i), LookIn:=xlValues, LookAt:=xlPart)
  6. If Not R Is Nothing Then
  7. FirstFound = R.Address
  8. Do
  9. If Month(R.Offset(0, -2)) = Month(madate) Then tot = tot + 1
  10. Set R = Plg.FindNext(R)
  11. Loop While Not R Is Nothing And R.Address <> FirstFound
  12. Else
  13. Erreurs = Erreurs & """" & tab_equip(i) & """" & " n'est pas répertorié."
  14. End If
  15. Next
  16. MsgBox Erreurs

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 ... :D 
Mais je cherche, je cherche!! :chaudar: 
a b L Programmation
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 ;) 
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!! :p 

Sinon j'ai un truc qui marche
  1. Option Explicit
  2. Sub indicateur()
  3.  
  4. 'déclaration des variables
  5. Dim TheName As String
  6. Dim F As Worksheet
  7. Dim R As Range
  8. Dim FirstFound As String
  9. Dim d As String
  10. Dim madate As Date
  11. Dim Plg As Range
  12. Dim LastLine As Long
  13. Dim tab_equip(9) As Variant
  14. Dim tab_total(9) As Variant
  15. Dim cell As Variant
  16. Dim Erreurs As String
  17. Dim ligne As String
  18. Dim total As Integer
  19. Dim i As Integer
  20. Dim J As Integer
  21.  
  22. 'définition des variables
  23. Set F = Worksheets("Feuil2")
  24.  
  25. tab_equip(0) = "snc"
  26. tab_equip(1) = "atsr"
  27. tab_equip(2) = "tsn"
  28. tab_equip(3) = "planar"
  29. tab_equip(4) = "pee"
  30. tab_equip(5) = "eh"
  31. tab_equip(6) = "sas"
  32. tab_equip(7) = "sts"
  33. tab_equip(8) = "1000"
  34. tab_equip(9) = "coris"
  35.  
  36. 'on désactive les filtres existants
  37. Worksheets("Feuil2").AutoFilterMode = False
  38.  
  39. 'ou se trouve la derniere ligne?
  40. LastLine = WorksheetFunction.Max(F.Cells(F.Rows.Count, "F").End(xlUp).Row)
  41.  
  42. 'on supprime les commentaires de la colonne description pour garder les num d'avis
  43. For Each cell In F.Range("E5:E" & LastLine)
  44. cell.Formula = Mid(cell.Formula, 1, 15)
  45. Next
  46.  
  47.  
  48.  
  49. i = 0
  50. Erreurs = ""
  51. total = 0
  52.  
  53. Do
  54. d = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "Date")
  55.  
  56. Loop While Not IsDate(d)
  57. madate = CDate(d)
  58.  
  59.  
  60. Set Plg = F.Range(F.Cells(5, 4), F.Cells(LastLine, 4))
  61. For i = LBound(tab_equip) To UBound(tab_equip)
  62. Set R = Plg.Find(tab_equip(i), LookIn:=xlValues, LookAt:=xlPart)
  63. If Not R Is Nothing Then
  64. FirstFound = R.Address
  65. Do
  66. If Month(R.Offset(0, -2)) = Month(madate) Then tab_total(i) = tab_total(i) + 1
  67. Set R = Plg.FindNext(R)
  68.  
  69. Loop While Not R Is Nothing And R.Address <> FirstFound
  70. Else
  71. Erreurs = Erreurs & """" & tab_equip(i) & """" & " n'est pas répertorié."
  72. End If
  73. Next
  74.  
  75. For i = 0 To 9
  76. total = total + tab_total(i)
  77. ligne = ligne & tab_equip(i) & Chr(9) & tab_total(i) & Chr(13)
  78. Next i
  79.  
  80. MsgBox ligne & "nombre d'intervention ADN: " & total
  81.  
  82. End Sub


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