Option Explicit
Sub recherche2()
Dim Lig As Long
Dim Trouve As Boolean
Dim Liste() As String
Dim i As Integer, j As Integer
Dim c As Range
Dim firstAddress As String
Dim Message As String
'initialisation des variables
i = 0
Trouve = False
'on limite la recherche à la colonne du premier critère (colonne A)
With Sheets("Feuil1").Range("A3:A" & Sheets("Feuil1").UsedRange.Rows.Count)
'on recherche toutes les occurences du premier critère dans la colonne A
Set c = .Find("*" & Sheets("Feuil1").Range("E4").Value & "*", , xlFormulas, xlPart, xlByRows, xlNext, False, False)
If Not c Is Nothing Then
firstAddress = c.Address
Do While Not c Is Nothing
'test si le deuxième critère est OK
If Sheets("Feuil1").Range("B" & c.Row).Value = Sheets("Feuil1").Range("F4").Value And Trouve = False Then
i = i + 1
ReDim Preserve Liste(1, i)
Liste(0, i) = c.Row
Liste(1, i) = "Crit 1=" & c.Value & "; Crit2=" & Sheets("Feuil1").Range("B" & c.Row).Value
Trouve = True
c.Select
ElseIf Sheets("Feuil1").Range("B" & c.Row).Value = Sheets("Feuil1").Range("F4").Value And Trouve = True Then
i = i + 1
ReDim Preserve Liste(1, i)
Liste(0, i) = c.Row
Liste(1, i) = "Crit 1=" & c.Value & "; Crit2=" & Sheets("Feuil1").Range("B" & c.Row).Value
End If
Set c = .FindNext(c)
If c Is Nothing Then Exit Do
If c.Address = firstAddress Then Exit Do
Loop
's'il ya des doublons dans les occurences trouvées
If i > 1 Then
Message = "ATTENTION! Résultat = " & i & " occurences trouvées!"
For j = 1 To i
Message = Message & vbCr & "Ligne = " & Liste(0, j) & " - " & Liste(1, j)
Next j
MsgBox Message
End If
End If
End With
End Sub