[VBA] Fonction find avec plusieurs criteres

Fonction find avec plusieurs criteres [VBA] - VB/VBA/VBS - Programmation

Marsh Posté le 06-11-2012 à 13:23:20    

Bonjour tout le monde!
 
J'ai réalisé un code qui me permet en fonction du mot renseigné ds une inputbox de trouver et de compter (1fois seulement) combien de fois ce mot apparaît dans la colonne D ( le principe de find en fait!!  :na: )
[cpp=]Option Explicit
 
Sub RechercherNom()
 
Dim TheName As String
Dim F As Worksheet
Dim R As Range
Dim FirstFound As String
Dim SNC As String
Dim C As Range
Dim Plg As Range
Dim Plg2 As Range
Dim Plg3 As Range
Dim EcartNeg As Integer
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)
 
 
'initialisation du compteur  
SNC = 0
 
 
 
'on rentre le mot à trouver dans la colonne
TheName = InputBox("Entrez le Nom de l'équipement :", "Nom" )
 
' on définit la plage de recherche soit la colonne D
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)
                SNC = SNC + 1 'on incrémente le compteur  
            Loop While R.Address <> FirstFound
 
        Else
            MsgBox ("Ce nom n'est pas répertorié" ) 'message si le mot n'est pas trouvé
 
        End If
 
End With
 
' on affiche les valeurs
 MsgBox SNC & "  " & LastLine  
 
 
End Sub[/cpp]
 
ce que je n'arrive pas à faire, ou plutot, comment le faire:
le tableau dont je dispose est une extraction d'un logiciel qui me sort toutes les interventions sur différent équipements en fonction de la date. le but final de cette macro est de compter en fonction de la date le nombre d'intervention par équipement(pour tel équipement tant d'intervention).
 
en gros:  
pour tous les équipements dans la liste(les équipements sont connus), trouver le nombre de fois l'équipement et incrémenter le compteur qui correspond à l'équipement...  :whistle:  suis-je clair?  
 
merci d'avance!!  :jap:  

Reply

Marsh Posté le 06-11-2012 à 13:23:20   

Reply

Marsh Posté le 06-11-2012 à 15:14:44    

Bonjour,
 
Tu peux tester la valeur de la colonne date en utilisant "offset".

Code :
  1. With Plg
  3.     Set R = .Find(TheName, LookIn:=xlValues, LookAt:=xlPart)
  4.         If Not (R Is Nothing) Then
  5.             FirstFound = R.Address
  6.             Do
  7.                 Set R = .FindNext(R)
  8.                 if R.offset(0, -2) = MaDate then
  9.                 SNC = SNC + 1 'on incrémente le compteur
  10.                 end if 
  11.             Loop While R.Address <> FirstFound
  13.         Else
  14.             MsgBox ("Ce nom n'est pas répertorié" ) 'message si le mot n'est pas trouvé
  16.         End If
  18. End With


 
Je te laisse regarder l'aide pour offset pour voir comment ça fonctionne  ;)

Message cité 1 fois

---------------
Bel ours Vave, je me dois de l’admettre. -Skyl"win"-  Mais toi tu es intelligent -Homerde- - Ce génie -SkylWINd- JDD S16M72 10:43:46 GMT-DTC +1
Reply

Marsh Posté le 06-11-2012 à 16:27:33    

vave a écrit :

Bonjour,
 
Tu peux tester la valeur de la colonne date en utilisant "offset".
 
 
Je te laisse regarder l'aide pour offset pour voir comment ça fonctionne  ;)


 
salut oovaveoo, et merci de ta réponse.
 
le R.offset(0,2) fait un décalage de 2 colonnes vers la gauche et de 0 ligne si la date (Madate) est bonne alors ca incrémente le compteur.
 mais en pratique ça marche pas (ou alors j'air rien compris... :pt1cable: )
voila ce que j'ai fait à partir de ton code:
 

Code :
  1. Option Explicit
  3. Sub RechercherNom()
  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 C As Range
  13. Dim Plg As Range
  14. Dim EcartNeg As Integer
  15. Dim LastLine As Long
  18. Set F = Worksheets("Feuil2" )
  20. 'ou se trouve la derniere ligne?
  21. LastLine = WorksheetFunction.Max(F.Cells(F.Rows.Count, "F" ).End(xlUp).Row)
  23. tot = 0
  25. d = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date" )
  26. madate = CDate(d)
  28. TheName = InputBox("Entrez le Nom de l'équipement :", "Nom" )
  30. Set Plg = F.Range(F.Cells(5, 4), F.Cells(LastLine, 4))
  32. With Plg
  34.     Set R = .Find(TheName, LookIn:=xlValues, LookAt:=xlPart)
  35.         If Not (R Is Nothing) Then
  36.             FirstFound = R.Address
  37.             Do
  38.                 'R.Offset(0, 1).Value = "Trouvé !"
  39.                 Set R = .FindNext(R)
  40.                 If R.Offset(0, -2) = madate Then
  41.                 tot = tot + 1
  42.                 End If
  43.             Loop While R.Address <> FirstFound
  45.         Else
  46.             MsgBox ("Ce nom n'est pas répertorié" )
  48.         End If
  50. End With
  52. MsgBox tot & "  " & LastLine
  55. End Sub


 
avec le F8 on voit bien que  If R.Offset(0, -2) = madate Then n'est jamais vérifié.


Message édité par tithom le 06-11-2012 à 16:42:30
Reply

Marsh Posté le 06-11-2012 à 16:33:39    

C'est quoi qui ne fonctionne pas ?
Ca te donne tot = 0 au final ?
 
Si oui, il y a sans doute une différence de format entre "madate" et les dates du fichier excel.
Mets un point d'arrêt sur la ligne 40 et vérifies les valeurs de "R.Offset(0, -2)" et de "madate".
 

Message cité 1 fois

---------------
Bel ours Vave, je me dois de l’admettre. -Skyl"win"-  Mais toi tu es intelligent -Homerde- - Ce génie -SkylWINd- JDD S16M72 10:43:46 GMT-DTC +1
Reply

Marsh Posté le 06-11-2012 à 16:47:59    

vave a écrit :

C'est quoi qui ne fonctionne pas ?
Ca te donne tot = 0 au final ?
 
Si oui, il y a sans doute une différence de format entre "madate" et les dates du fichier excel.
Mets un point d'arrêt sur la ligne 40 et vérifies les valeurs de "R.Offset(0, -2)" et de "madate".
 


 
 
exact tot=0... dans une macro précédente, je voulais faire un filtre auto sur la date: impossible avec ce code:  
 

Code :
  1. Dim d1 As String
  2. Dim d2 As String
  3. Dim d1_bis As Date
  4. Dim d2_bis As Date
  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 = CDate(d1)
  10. d2_bis = CDate(d2)
  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


 
je vais voir si mes valeurs sont bonne avec le point d'arret


Message édité par tithom le 06-11-2012 à 16:49:11
Reply

Marsh Posté le 06-11-2012 à 16:53:38    

c'est bon j'ai trouvé une parade:
 

Code :
  1. With Plg
  3.     Set R = .Find(TheName, LookIn:=xlValues, LookAt:=xlPart)
  4.         If Not (R Is Nothing) Then
  5.             FirstFound = R.Address
  6.             Do
  7.                 'R.Offset(0, 1).Value = "Trouvé !"
  8.                 Set R = .FindNext(R)
  9.                 If Month(R.Offset(0, -2)) = Month(madate) Then
  10.                 tot = tot + 1
  11.                 End If
  12.             Loop While R.Address <> FirstFound


 
avec juste le mois cela fonctionne! :D
 
il me reste à trouver une solution pour faire tourner cette boucle en fonction de plusieurs "thename"!


Message édité par tithom le 06-11-2012 à 17:06:54
Reply

Marsh Posté le 06-11-2012 à 17:50:19    

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  

Code :
  1. Dim tab_equip(9) As Variant
  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?? je ne l'ai pas fait marcher.. juste une idée!!  

Code :
  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
  12.         Else
  13.             MsgBox ("Ce nom n'est pas répertorié" )
  15.         End If
  17. End With
  18. next tab_equip()


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

Reply

Marsh Posté le 12-11-2012 à 22:16:59    

Bon j'ai un peu avancé,  masi j'ai besoin d'un coup de main....  
 
j'ai un code comme ça maintenant,    
 
 

Code :
  1. Option Explicit
  3. Sub RechercherNom()
  6. 'déclaration des variables
  7. Dim TheName As String
  8. Dim F As Worksheet
  9. Dim R As Range
  10. Dim FirstFound As String
  11. Dim tot As String
  12. Dim d As String
  13. Dim madate As Date
  14. Dim Plg As Range
  15. Dim LastLine As Long
  16. Dim tab_equip(9) As Variant
  17. Dim Erreurs As String
  18. Dim i As Integer
  20. 'définition des variables
  21. Set F = Worksheets("Feuil2" )
  23. tab_equip(0) = "snc"
  24. tab_equip(1) = "atsr"
  25. tab_equip(2) = "tsn"
  26. tab_equip(3) = "planar"
  27. tab_equip(4) = "pee"
  28. tab_equip(5) = "eh"
  29. tab_equip(6) = "sas"
  30. tab_equip(7) = "sts"
  31. tab_equip(8) = "1000"
  32. tab_equip(9) = "coris"
  37. 'ou se trouve la derniere ligne?
  38. LastLine = WorksheetFunction.Max(F.Cells(F.Rows.Count, "F" ).End(xlUp).Row)
  40. tot = 0
  41. i = 0
  42. Erreurs = 0
  44. d = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date" )
  45. madate = CDate(d)
  47. 'TheName = InputBox("Entrez le Nom de l'équipement :", "Nom" )
  48. 'TheName = tab_equip()
  50. Set Plg = F.Range(F.Cells(5, 4), F.Cells(17, 4))
  51. For i = LBound(tab_equip) To UBound(tab_equip)
  52. Set R = Plg.Find(tab_equip(i), LookIn:=xlValues, LookAt:=xlPart)
  53. If Not R Is Nothing Then
  54. FirstFound = R.Address
  55. Do
  56. If Month(R.Offset(0, -2)) = Month(madate) Then tot = tot + 1
  57. Set R = Plg.FindNext(R)
  58. Loop While Not R Is Nothing And R.Address <> FirstFound
  59. Else
  60. Erreurs = Erreurs & """" & tab_equip(i) & """" & " n'est pas répertorié."
  61. End If
  62. Next
  63. MsgBox Erreurs
  66. End Sub


 
mais il ne marche pas des masses.... il ne m'affiche que ce qu'il n'y a pas, et ne fait pas de total pour chaque tab_equipement! ya du taf encore!!

Reply

Marsh Posté le 13-11-2012 à 07:12:11    

Pourquoi tu ne mets pas tout simplement tes totaux dans un 2ème tableau ?

Code :
  1. Dim tab_equip(9) As Variant
  2. Dim tab_total(9) As Variant
  3. [...]
  4. If Month(R.Offset(0, -2)) = Month(madate) Then tab_total(i) = tab_total(i) + 1


 
Une fois la macro finie, tu n'as plus qu'à parcourir tes deux tableaux pour avoir les résultats :

Code :
  1. For j = LBound(tab_equip) To UBound(tab_equip)
  2.    msgbox "équipe : " & tab_equip(j) & " - total = " & tab_total(j)
  3. Next j


---------------
Bel ours Vave, je me dois de l’admettre. -Skyl"win"-  Mais toi tu es intelligent -Homerde- - Ce génie -SkylWINd- JDD S16M72 10:43:46 GMT-DTC +1
Reply

Marsh Posté le 13-11-2012 à 18:24:52    

salut oovaveoo,  
 
merci pour ce bout de code!!  
 
j’avais pas du tout pensé à faire un 2eme tableau...  :pt1cable:  
donc merci!!  :jap:  
voila mon code  
 

Code :
  1. Option Explicit
  2. Sub indicateur()
  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
  22. 'définition des variables
  23. Set F = Worksheets("Feuil2" )
  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"
  36. 'on désactive les filtres existants
  37. Worksheets("Feuil2" ).AutoFilterMode = False
  39. 'ou se trouve la derniere ligne?
  40. LastLine = WorksheetFunction.Max(F.Cells(F.Rows.Count, "F" ).End(xlUp).Row)
  42. 'on supprime les commentaires de la colonne descrition 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
  49. i = 0
  50. Erreurs = ""
  51. total = 0
  52. d = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date" )
  53. madate = CDate(d)
  56. Set Plg = F.Range(F.Cells(5, 4), F.Cells(LastLine, 4))
  57.         For i = LBound(tab_equip) To UBound(tab_equip)
  58.             Set R = Plg.Find(tab_equip(i), LookIn:=xlValues, LookAt:=xlPart)
  59.         If Not R Is Nothing Then
  60.             FirstFound = R.Address
  61.     Do
  62.         If Month(R.Offset(0, -2)) = Month(madate) Then tab_total(i) = tab_total(i) + 1
  63.         Set R = Plg.FindNext(R)
  64.        
  65. Loop While Not R Is Nothing And R.Address <> FirstFound
  66. Else
  67.         Erreurs = Erreurs & """" & tab_equip(i) & """" & " n'est pas répertorié."
  68. End If
  69. Next
  70.    
  71. For i = 0 To 9
  72.     total = total + tab_total(i)
  73.     ligne = ligne & tab_equip(i) & Chr(9) & tab_total(i) & Chr(13)
  74. Next i
  76. MsgBox ligne & "nombre d'intervention ADN:  " & total
  77.  
  78. End Sub


 
par contre je ne comprends pas pourquoi ce bout de code ne marche pas...  
 
 

Code :
  1. 'on filtre sur le mois demandé
  2.     f_avis.Range("$A$5:$H" & LastLine).AutoFilter Field:=2, Operator:= _
  3.         xlFilterValues, Criteria2:=Array(1, "madate" )


 
j'ai un beau erreur 1004: la méthode Autofilter de la classe range à échoué.... ce que je veux c'est le nombre de ligne qui comporte le mois (Month(madate))

Reply

Marsh Posté le 13-11-2012 à 18:24:52   

Reply

Marsh Posté le 14-11-2012 à 07:55:35    

Enlève le array, il ne sert à rien :

Code :
  1. 'on filtre sur le mois demandé
  2.         f_avis.Range("$A$5:$H" & LastLine).AutoFilter Field:=2, Operator:= _
  3.             xlFilterValues, Criteria2:=madate


---------------
Bel ours Vave, je me dois de l’admettre. -Skyl"win"-  Mais toi tu es intelligent -Homerde- - Ce génie -SkylWINd- JDD S16M72 10:43:46 GMT-DTC +1
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed