Discussion :

[astrid123]

Bonjour,

Je souhaiterais dans chaque cellule de la colonne E chercher sur deux termes différents. Le code ci-dessous ne correspond qu'à un seul terme de recherche ("XXXX"). Comment ajouter un second terme de recherche c.à.d sur "XXXX" AND "YYYYY" dans la même cellule ? Expressions régulières ?

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
Sub resume()
 
Dim i As Integer
Dim LR As Integer
 
 
LR = Sheets("automatisation resume").Range("C" & Rows.Count).End(xlUp).Row
 
For i = 1 To LR
 
If Not Range("E" & i).Find("XXXXXXX", LookAt:=xlPart, MatchCase:=True) Is Nothing Then
    Sheets("automatisation resume").Range("F" & i).Value = "AAAAA"
 
 
End If
 
 
Next i
 
End Sub

Merci d'avance,

A.

[BENNASR]

bonsoir
une proposition avec boucle

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub cherche()
Dim F As Worksheet
Dim I As Long
 Application.ScreenUpdating = False
 Set F = Sheets("automatisation resume")
I = F.Cells(Rows.Count, 5).End(xlUp).Row
Dim C As Range
For Each C In F.Range("E2:E" & I)
If C.Value = "XXXX" And C.Offset(0, 1).Value = "YYYY" Then MsgBox "j'ai trouvé dans la ligne numéro :   " & C.Row
Next C
 Application.ScreenUpdating = True
End Sub

[BENNASR]

avec un filtre

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub testtt()
Dim F As Worksheet
Dim I As Long
 Application.ScreenUpdating = False
 Set F = Sheets("automatisation resume")
I = F.Cells(Rows.Count, 5).End(xlUp).Row
F.Range("A1:F" & I).AutoFilter Field:=5, Criteria1:="XXXX"
F.Range("A1:F" & I).AutoFilter Field:=6, Criteria1:="YYYY"
 Application.ScreenUpdating = True
End Sub

[MarcelG]

Bonsoir,

Autre piste

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
Option Explicit
 
Public Sub cherche_double()
 
Dim dernl As Long
Dim c As Range
 
With Feuil1
        dernl = .Cells(.Rows.Count, 5).End(xlUp).Row
        For Each c In .Range("E1:E" & dernl)
                With c
                        If InStr(.Value, "pa") > 0 And InStr(.Value, "mo") > 0 Then
                                Debug.Print .Address
                        End If
                End With
        Next c
End With
 
End Sub

Un autre processus aurait consisté à créer l'union des cellules contenant le 1er terme en utilisant la méthode Fiind.
Ensuite, chercher le 2ème terme dans cet objet Range créé.

[MarcelG]

Vraiment pour se faire plaisir.
Je préfère le 1er code

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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Option Explicit
 
Public Sub cherche_double_V2()
 
Dim dernl As Long
Dim t As Range, P As Range
Dim ladress As String
 
Dim c As Range
 
With Feuil1
        dernl = .Cells(.Rows.Count, 5).End(xlUp).Row
        With .Range("E1:E" & dernl)
                Set t = .Find(What:="pa", Lookat:=xlPart)
                If Not t Is Nothing Then
                        ladress = t.Address
                        Do
                                If P Is Nothing Then
                                        Set P = t
                                Else
                                        Set P = Union(P, t)
                                End If
                                Set t = .FindNext(t)
                        Loop While Not t Is Nothing And t.Address <> ladress
                End If
        End With
End With
 
Debug.Print P.Address
 
If Not P Is Nothing Then
 
        With P
                Set t = .Find(What:="mo", Lookat:=xlPart)
                If Not t Is Nothing Then
                        ladress = t.Address
                        Do
                                Debug.Print t.Address
                                Set t = .FindNext(t)
                        Loop While Not t Is Nothing And t.Address <> ladress
                End If
        End With
 
End If
 
 
If Not t Is Nothing Then _
        Set t = Nothing
 
If Not P Is Nothing Then _
        Set P = Nothing
 
End Sub

Bonne soirée à vous. Bonne soirée au Forum.