VBA - Comment utiliser FIND avec une liste de critères et une plage de recherche ?
Bonjour,
J’ai besoin de compléter une liste de produits (feuille « ListeProduits », contenant les NomProduits), avec le nom d’un composant, un antibiotique dont le libellé est contenu dans le NomProduit, et du code article de cet antibiotique.
Je dispose pour cela, d’une table (feuille « ListeAntibio ») avec la liste des antibiotiques (NomAntibio) et leur code article (CodeAntibio).
Les 2 feuilles « ListeProduits » et « ListeAntibio » sont dans le même classeur.
Procédant par étapes je dispose d’une macro construite avec la fonction FIND (que je connais grâce à un champion de ce forum !), qui renvoie correctement le NomAntibio et le CodeAntibio de la feuille « ListeAntibio » à côté du NomProduit de la feuille « ListeProduits ».
Cette « maquette » ne fonctionne que si les NomProduits ont exactement le même libellés que les NomAntibio.
Selon mes recherches sur le net, il faut maintenant que je remplace la fonction FIND par la fonction LIKE pour trouver les NomProduits de la plage de recherche « ListeProduits » contenant une chaine de caractères parmi celles de la « ListeAntibio ».
Je m’adresse donc au champions, pour m’aider à combiner FIND avec une liste de critères et une plage de recherche !
Alors, qui veut bien relever le défi ? … s’en est un sacré pour moi, la débutante !
D’avance un grand merci à mon sauveteur !
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
| Sub Macro_3_Recherche_NomAntibio_dans_NomProduit()
'
Dim Origine As Worksheet, Dest As Worksheet
Set Origine = Worksheets("ListeAntibio")
Set Dest = Sheets("ListeProduits")
Dim NomAntibio As Variant
Dim NomProduit As Variant
Dim LigneProduit As Variant
Dim LigneAntibio As Variant
Dim reponse
Dim i As Long
Dim R As Range
'Dans Origine :
For i = 2 To Rows.Count
NomAntibio = Origine.Cells(i, 1).Value
LigneAntibio = Origine.Cells(i, 1).Row
If NomAntibio = "" Then
Exit For ' pour sortir de cette routine FOR...NEXT
Else
'Voilà la ligne q'il faut remplacer par Find...
Set R = Dest.Range("A1:A100").Find(What:=NomAntibio, LookIn:=xlFormulas, LookAt:=xlWhole)
If R Is Nothing Then
'reponse = MsgBox(NomAntibio & " non trouvé ", vbOKCancel, "Erreur")
'If reponse = vbCancel Then Exit Sub
Else
LigneProduit = R.Row
CodeAntibio = Origine.Cells(LigneAntibio, 2).Value
Dest.Cells(LigneProduit, 1).Offset(0, 2).Value = NomAntibio
Dest.Cells(LigneProduit, 1).Offset(0, 3).Value = CodeAntibio
End If
End If
Next
End Sub |
VBA - FindNext pour trouver toutes les occurences d'une fonction Find
Bonjour Patrick,
J'ai bien investigué la piste que tu me conseilles pour traiter toutes les occurences de la recherche Find (FindNext dans un do/loop après Find).
Il me semble que je ne suis plus très loin de la solution, mais je ne sais pas corriger une erreur de compil concernant la ligne surlignée en jaune "Set R= .FindNext (R)". Le correcteur indique "Ref Incorrecte ou Non Qualifiée".
Pourrais-tu m'aider à sortir de l'impasse ?
D'avance tous mes remerciements
Marino
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
Sub Macro5()
' =Macro4 avec do loop
Dim Origine As Worksheet, Dest As Worksheet
Set Origine = Worksheets("ListeAntibio")
Set Dest = Sheets("ListeProduits")
Dim NomAntibio As Variant
Dim LigneProduit As Variant
Dim LigneAntibio As Variant
Dim FirstAddress As String
Dim reponse
Dim i As Long
Dim R As Range
'Dans Origine :
For i = 2 To Rows.Count
NomAntibio = Origine.Cells(i, 1).Value
LigneAntibio = Origine.Cells(i, 1).Row
If NomAntibio = "" Then
Exit For ' pour sortir de cette routine FOR...NEXT
Else
Set R = Dest.Range("A1:A1000").Find(What:=NomAntibio, LookIn:=xlFormulas, LookAt:=xlPart)
'XlPart à la place de WlWhole, pour rechercher NomAntibio dans les chaines de caractères de NomProduit
If R Is Nothing Then
'reponse = MsgBox(NomAntibio & " non trouvé ", vbOKCancel, "Erreur")
'If reponse = vbCancel Then Exit Sub
Else 'equivalent à : If Not R Is Nothing Then
FirstAddress = R.Address 'repérage du 1er résultat trouvé
Do
LigneProduit = R.Row
If Dest.Cells(LigneProduit, 1).Offset(0, 2).Value = "" Then
'pour que les resultats des NomAntibio dont la chaine de caractère est incluse dans d'autres NomAntibio n'écrasent pas les résultats de ces derniers.
NomAntibio = Origine.Cells(LigneAntibio, 2).Value
CodeAntibio = Origine.Cells(LigneAntibio, 3).Value
Dest.Cells(LigneProduit, 1).Offset(0, 1).Value = NomAntibio
Dest.Cells(LigneProduit, 1).Offset(0, 2).Value = CodeAntibio
End If
Set R = .FindNext(R)
Loop While Not R Is Nothing And R.Address <> FirstAddress
End If
End If
Next
'
'
End Sub |
