Discussion :

[roidurif]

Bonjour,

Je souhaite faire une MACRO qui dit que si dans la cellule, il trouve au minimum les deux texte(s) recherché(s) de l’onglet « table de correspondance », alors en résultat on doit avoir le code article de la colonne B.

La complexité est parfois le(s) texte(s) recherché(s) peuvent être au pluriel, voir contiennent des déterminants comme ‘de’ par exemple, etc.



Merci de votre aide.

[Theze]

Bonsoir,

Une piste en attendant plus de précisions :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub Chercher()
 
    Dim Plage As Range
    Dim Cel_1 As Range
    Dim Cel_2 As Range
    Dim Mot1 As String
    Dim Mot2 As String
 
    'mots recherchés
    Mot1 = "MonMot1"
    Mot2 = "MonMot2"
 
    'plage à adpater
    Set Plage = Range("A1:A100")
 
    'recherche les mots dans les chaînes contenues dans les cellules
    Set Cel_1 = Plage.Find(Mot1, , xlValues, xlPart)
    Set Cel_2 = Plage.Find(Mot2, , xlValues, xlPart)
 
    'si les deux mots sont trouvés et que les deux cellules ont la même adresse, OK
    If Not Cel_1 Is Nothing And Not Cel_2 Is Nothing Then
 
        If Cel_1.Address(0, 0) = Cel_2.Address(0, 0) Then
 
            MsgBox "Les mots '" & Mot1 & "' '" & Mot2 & "' sont dans la cellule " & Cel_1.Address(0, 0)
 
            'ici ton code...
 
        End If
 
    End If
 
End Sub

Hervé.

[patricktoulon]

bonsoir

pour completer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 MsgBox "Les mots '" & Mot1 & "' '" & Mot2 & "' sont dans la cellule " & Cel_1.Address(0, 0) & vbCrLf & _
            "la valeur est" & Cells(Cel_1.Row, "B")

au plaisir

[roidurif]

Bonsoir,

Merci pour vos réponses. j'ai ajusté en fonction de votre proposition, par contre la macro ne balaye pas toutes les cellules j'ai l'impression. Par exemple l'ACIDE SULFURIQUE n'est pas trouvé, alors que normalement cela devrait.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub Chercher()
 
    Dim Plage As Range
    Dim Cel_1 As Range
    Dim Cel_2 As Range
    Dim Mot1 As String
    Dim Mot2 As String
 
    'mots recherchés
    For x = 1 To 82
    Mot1 = Sheets("Feuil3").Range("B" & x)
    Mot2 = Sheets("Feuil3").Range("C" & x)
 
    'plage à adpater
    Set Plage = Sheets("Feuil1").Range("A1:A1000")
 
    'recherche les mots dans les chaînes contenues dans les cellules
    Set Cel_1 = Plage.Find(Mot1, , xlValues, xlPart)
    Set Cel_2 = Plage.Find(Mot2, , xlValues, xlPart)
'Debug.Print Mot1
'Debug.Print Mot2
    'si les deux mots sont trouvés et que les deux cellules ont la même adresse, OK
    If Not Cel_1 Is Nothing And Not Cel_2 Is Nothing Then
 
        If Cel_1.Address(0, 0) = Cel_2.Address(0, 0) Then
        Sheets("Feuil3").Range("B" & x).Offset(, 5) = "X"
            'MsgBox "Les mots '" & Mot1 & "' '" & Mot2 & "' sont dans la cellule " & Cel_1.Address(0, 0)
 
        End If
 
    End If
 Next x
End Sub

Merci encore

[Theze]

Bonjour,

Poste un exemple de classeur car il n'y a pas de raison que ça ne fonctionne pas !

Hervé.

[roidurif]

Bonjour,

Voici mon fichier joint pour lequel la macro ne balaye pas toutes les cellules. Par exemple l'ACIDE SULFURIQUE n'est pas trouvé, alors que normalement cela devrait.

Merci de votre aide