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


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


---------------
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
  2. Sub RechercherNom()
  3. Dim TheName As String
  4. Dim F As Worksheet
  5. Dim R As Range
  6. Dim FirstFound As String
  7. Dim tot As String
  8. Dim d As String
  9. Dim madate As Date
  10. Dim C As Range
  11. Dim Plg As Range
  12. Dim EcartNeg As Integer
  13. Dim LastLine As Long
  14. Set F = Worksheets("Feuil2" )
  15. 'ou se trouve la derniere ligne?
  16. LastLine = WorksheetFunction.Max(F.Cells(F.Rows.Count, "F" ).End(xlUp).Row)
  17. tot = 0
  18. d = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date" )
  19. madate = CDate(d)
  20. TheName = InputBox("Entrez le Nom de l'équipement :", "Nom" )
  21. Set Plg = F.Range(F.Cells(5, 4), F.Cells(LastLine, 4))
  22. With Plg
  23.     Set R = .Find(TheName, LookIn:=xlValues, LookAt:=xlPart)
  24.         If Not (R Is Nothing) Then
  25.             FirstFound = R.Address
  26.             Do
  27.                 'R.Offset(0, 1).Value = "Trouvé !"
  28.                 Set R = .FindNext(R)
  29.                 If R.Offset(0, -2) = madate Then
  30.                 tot = tot + 1
  31.                 End If
  32.             Loop While R.Address <> FirstFound
  33.         Else
  34.             MsgBox ("Ce nom n'est pas répertorié" )
  35.         End If
  36. End With
  37. MsgBox tot & "  " & LastLine
  38. 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".
 


---------------
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
  5. 'on demande la date (je veux en fait filtrer sur un 1 mois)
  6. d1 = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date de début" )
  7. d2 = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date de fin" )
  8. d1_bis = CDate(d1)
  9. d2_bis = CDate(d2)
  10. 'on filtre sur le mois
  11.     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
  2.     Set R = .Find(TheName, LookIn:=xlValues, LookAt:=xlPart)
  3.         If Not (R Is Nothing) Then
  4.             FirstFound = R.Address
  5.             Do
  6.                 'R.Offset(0, 1).Value = "Trouvé !"
  7.                 Set R = .FindNext(R)
  8.                 If Month(R.Offset(0, -2)) = Month(madate) Then
  9.                 tot = tot + 1
  10.                 End If
  11.             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
  2. tab_equip(0) = "snc"
  3. tab_equip(1) = "atsr"
  4. tab_equip(2) = "tsn"
  5. tab_equip(3) = "planar"
  6. tab_equip(4) = "pee"
  7. tab_equip(5) = "eh"
  8. tab_equip(6) = "sas"
  9. tab_equip(7) = "sts"
  10. tab_equip(8) = "1000"
  11. 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
  11.         Else
  12.             MsgBox ("Ce nom n'est pas répertorié" )
  13.         End If
  14. End With
  15. 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
  2. Sub RechercherNom()
  3. 'déclaration des variables
  4. Dim TheName As String
  5. Dim F As Worksheet
  6. Dim R As Range
  7. Dim FirstFound As String
  8. Dim tot 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 Erreurs As String
  15. Dim i As Integer
  16. 'définition des variables
  17. Set F = Worksheets("Feuil2" )
  18. tab_equip(0) = "snc"
  19. tab_equip(1) = "atsr"
  20. tab_equip(2) = "tsn"
  21. tab_equip(3) = "planar"
  22. tab_equip(4) = "pee"
  23. tab_equip(5) = "eh"
  24. tab_equip(6) = "sas"
  25. tab_equip(7) = "sts"
  26. tab_equip(8) = "1000"
  27. tab_equip(9) = "coris"
  28. 'ou se trouve la derniere ligne?
  29. LastLine = WorksheetFunction.Max(F.Cells(F.Rows.Count, "F" ).End(xlUp).Row)
  30. tot = 0
  31. i = 0
  32. Erreurs = 0
  33. d = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date" )
  34. madate = CDate(d)
  35. 'TheName = InputBox("Entrez le Nom de l'équipement :", "Nom" )
  36. 'TheName = tab_equip()
  37. Set Plg = F.Range(F.Cells(5, 4), F.Cells(17, 4))
  38. For i = LBound(tab_equip) To UBound(tab_equip)
  39. Set R = Plg.Find(tab_equip(i), LookIn:=xlValues, LookAt:=xlPart)
  40. If Not R Is Nothing Then
  41. FirstFound = R.Address
  42. Do
  43. If Month(R.Offset(0, -2)) = Month(madate) Then tot = tot + 1
  44. Set R = Plg.FindNext(R)
  45. Loop While Not R Is Nothing And R.Address <> FirstFound
  46. Else
  47. Erreurs = Erreurs & """" & tab_equip(i) & """" & " n'est pas répertorié."
  48. End If
  49. Next
  50. MsgBox Erreurs
  51. 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()
  3. 'déclaration des variables
  4. Dim TheName As String
  5. Dim F As Worksheet
  6. Dim R As Range
  7. Dim FirstFound As String
  8. Dim d As String
  9. Dim madate As Date
  10. Dim Plg As Range
  11. Dim LastLine As Long
  12. Dim tab_equip(9) As Variant
  13. Dim tab_total(9) As Variant
  14. Dim cell As Variant
  15. Dim Erreurs As String
  16. Dim ligne As String
  17. Dim total As Integer
  18. Dim i As Integer
  19. Dim J As Integer
  20. 'définition des variables
  21. Set F = Worksheets("Feuil2" )
  22. tab_equip(0) = "snc"
  23. tab_equip(1) = "atsr"
  24. tab_equip(2) = "tsn"
  25. tab_equip(3) = "planar"
  26. tab_equip(4) = "pee"
  27. tab_equip(5) = "eh"
  28. tab_equip(6) = "sas"
  29. tab_equip(7) = "sts"
  30. tab_equip(8) = "1000"
  31. tab_equip(9) = "coris"
  32. 'on désactive les filtres existants
  33. Worksheets("Feuil2" ).AutoFilterMode = False
  34. 'ou se trouve la derniere ligne?
  35. LastLine = WorksheetFunction.Max(F.Cells(F.Rows.Count, "F" ).End(xlUp).Row)
  36. 'on supprime les commentaires de la colonne descrition pour garder les num d'avis
  37. For Each cell In F.Range("E5:E" & LastLine)
  38.         cell.Formula = Mid(cell.Formula, 1, 15)
  39. Next
  40. i = 0
  41. Erreurs = ""
  42. total = 0
  43. d = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date" )
  44. madate = CDate(d)
  45. Set Plg = F.Range(F.Cells(5, 4), F.Cells(LastLine, 4))
  46.         For i = LBound(tab_equip) To UBound(tab_equip)
  47.             Set R = Plg.Find(tab_equip(i), LookIn:=xlValues, LookAt:=xlPart)
  48.         If Not R Is Nothing Then
  49.             FirstFound = R.Address
  50.     Do
  51.         If Month(R.Offset(0, -2)) = Month(madate) Then tab_total(i) = tab_total(i) + 1
  52.         Set R = Plg.FindNext(R)
  53.        
  54. Loop While Not R Is Nothing And R.Address <> FirstFound
  55. Else
  56.         Erreurs = Erreurs & """" & tab_equip(i) & """" & " n'est pas répertorié."
  57. End If
  58. Next
  59.    
  60. For i = 0 To 9
  61.     total = total + tab_total(i)
  62.     ligne = ligne & tab_equip(i) & Chr(9) & tab_total(i) & Chr(13)
  63. Next i
  64. MsgBox ligne & "nombre d'intervention ADN:  " & total
  65.  
  66. 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