[VBA] Fonction find avec plusieurs criteres

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : [VBA] Fonction find avec plusieurs criteres

tithom

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:

Publicité

vave

Nice to meet me

Bonjour,

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

Code :

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 R.offset(0, -2) = MaDate then
SNC = SNC + 1 'on incrémente le compteur
end if
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

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

tithom

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 :

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 C As Range
Dim Plg 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)
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
'R.Offset(0, 1).Value = "Trouvé !"
Set R = .FindNext(R)
If R.Offset(0, -2) = 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

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

vave

Nice to meet me

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

tithom

vave a écrit :

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

Code :

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 = CDate(d1)
d2_bis = CDate(d2)
'on filtre sur le mois
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

tithom

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

Code :

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

avec juste le mois cela fonctionne!

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

tithom

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 :

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?? je ne l'ai pas fait marcher.. juste une idée!!

Code :

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

Bon j'ai un peu avancé, masi j'ai besoin d'un coup de main....

j'ai un code comme ça maintenant,

Code :

Option Explicit
Sub RechercherNom()
'déclaration des variables
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
Dim tab_equip(9) As Variant
Dim Erreurs As String
Dim i 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"
'ou se trouve la derniere ligne?
LastLine = WorksheetFunction.Max(F.Cells(F.Rows.Count, "F" ).End(xlUp).Row)
tot = 0
i = 0
Erreurs = 0
d = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date" )
madate = CDate(d)
'TheName = InputBox("Entrez le Nom de l'équipement :", "Nom" )
'TheName = tab_equip()
Set Plg = F.Range(F.Cells(5, 4), F.Cells(17, 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 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
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!!

vave

Nice to meet me

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

Code :

Dim tab_equip(9) As Variant
Dim tab_total(9) As Variant
[...]
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 :

For j = LBound(tab_equip) To UBound(tab_equip)
msgbox "équipe : " & tab_equip(j) & " - total = " & tab_total(j)
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

tithom

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 :

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 descrition 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
d = InputBox("Veuillez saisir la date (mm/dd/yyy) :", "date" )
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 je ne comprends pas pourquoi ce bout de code ne marche pas...

Code :

'on filtre sur le mois demandé
f_avis.Range("$A$5:$H" & LastLine).AutoFilter Field:=2, Operator:= _
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))

Publicité

vave

Nice to meet me

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

Code :

'on filtre sur le mois demandé
f_avis.Range("$A$5:$H" & LastLine).AutoFilter Field:=2, Operator:= _
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

FORUM HardWare.fr

Programmation

VB/VBA/VBS

[VBA] Fonction find avec plusieurs criteres

Sujets relatifs
[VBA Visio 2010] Récupérer des données de formes	Code VBA (Revue analytique de 2 Balances)
[VBA] help formules personnalisées	(VBA) excel 2003 erreur 1004
Fonction excel	(VBA) Insertion automatique d'un n°
Fonction GetObject dans un webservice en ASP.NET	page HTML pour centrer verticalemetn plusieurs objets
Comment ajouter Order by dans cette fonction ?	[VBA] SaveAs sous 2007
Plus de sujets relatifs à : [VBA] Fonction find avec plusieurs criteres

Page générée en 0.108 secondes