Rapport de message :*
 

Re: une double recherche

Titre du sujet : Re: une double recherche
par myDearFriend! le 08/12/2022 13:24:34

Bonjour tactic6, le Forum,

 

Si j'ai bien interprété ta demande (pas sûr !), tu trouveras en pièce jointe peut-être une solution.

(un peu plus d'explications aurait été bienvenu...)

 

J'ai donc un peu modifié ton Userform et voici principalement le code que j'ai adapté :

'ICI C'est le Moteur de Recherche
Private Sub CommandButton1_Click()
Dim cTab As Range, cTabLign As Range
Dim tablo() As String
Dim Firstaddress As String, T1 As String, T2 As String
Dim i As Integer, x As Integer
Dim S As Byte

    T1 = Me.TextBox1
    T2 = Me.TextBox2
    If T1 = "" Then Exit Sub
    
    For S = 1 To Worksheets.Count
        With Sheets(S).UsedRange
            'Recherche 1ère expression dans la feuille
            Set cTab = .Find(T1, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns)
            If Not cTab Is Nothing Then
                Firstaddress = cTab.Address
                Do
                    'Présence 2ème expression (si non vide) sur la même ligne  ?
                    If T2 <> "" Then
                        Set cTabLign = cTab.EntireRow.Find(T2, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows)
                    Else
                        Set cTabLign = cTab
                    End If
                    '
                    If Not cTabLign Is Nothing Then
                        ReDim Preserve tablo(8, i)
                        For x = 1 To 6
                            tablo(x - 1, i) = cTab.Offset(0, x - cTab.Column).Text
                        Next x
                        tablo(6, i) = S
                        tablo(7, i) = cTab.Row
                        i = i + 1
                    End If
                    Set cTab = .Find(T1, After:=cTab, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns)
                Loop While Not cTab Is Nothing And cTab.Address <> Firstaddress
            End If
        End With
    Next S
    
    If i = 0 Then
        MsgBox "Aucune correspondance pour le(s) critère(s) saisi(s) !" & vbCrLf & "Faites un essai sur une partie d'expression", vbCritical, Sign
        Exit Sub
    End If
    
    Me.ListBox1.Column() = tablo()
End Sub

'ICI C'est la sélection au Double Click & Sortie du UserForm
Private Sub ListBox1_dblClick(ByVal Cancel As MSForms.ReturnBoolean)
    With ListBox1
        Application.Goto Sheets(Val(.Column(6))).Cells(Val(.Column(7)), 1)
    End With
    Unload Me
End Sub

En espérant que ça puisse être une piste à suivre pour toi.

Bien cordialement,