une double recherche | ||
---|---|---|
Inscription: 19/11/2011
Messages:
21
Système d'exploitation: PC Version Excel utilisée: 2010 |
Posté le : 08-12-2022 09h59
Bonjour à tous j'aimerai que l'userform ci joint ( Merci à Didier MyDearFriend ) fasse une autre recherche basée sur le résultat de la première et qu'ensuite un double clic sur la ligne cherchée nous ramene sur la cellule de la colone A correspondante de la ligne concernée de la Base de Données Est-ce possible?
Merci |
|
|
Re: une double recherche | ||
---|---|---|
Inscription: 18/05/2006
De Saône-et-Loire (71)
Messages:
1539
Système d'exploitation: PC Version Excel utilisée: 97, 2000, 2002, 2003, 2007, 2010, 2013, 2016 et 365 |
Posté le : 08-12-2022 13h24
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, Didier_mDF
Le Webmaster La réponse vous satisfait ? Merci de revenir solder le sujet en [résolu], voir ce lien |
|
|
Re: une double recherche | ||
---|---|---|
Inscription: 19/11/2011
Messages:
21
Système d'exploitation: PC Version Excel utilisée: 2010 |
Posté le : 08-12-2022 13h41
Tu es mon idole c'est exactement ma recherche |
|
|