Textbox Rechercher Une Valeur

Salut Forum,

Sans grande expèrience en VBA, je me suis "Bidouillé" une petite routine de Recherche ... Mais je ne parviens pas à continuer sur la recherche...


Je voudrai récupérer la valeur de "x" pour poursuivre sur les "x" similaires

Comme avec le "Suivant" de Ctrl+F dans Excel

Si quelqu'un a une Idée ?

Merci d'avance.

A+

Code:

---

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

Private Sub Button_Rechercher_Click()   If UserForm2.Désignation.Text = "" Then MsgBox "Vous devez saisir une Recherche", vbCritical End If   Dim x As Long ActiveSheet.Activate   For x = 4 To Range("A65535").End(xlUp).Row If UCase(Range("A" & x)) Like "*" & UCase(UserForm2.Désignation.Value) & "*" Then   GoTo Trouve Exit For End If Next x     GoTo Erreur Exit Sub   Trouve: LigneActive = x   UserForm2.Désignation.Value = ActiveSheet.Cells(LigneActive, "A").Value UserForm2.Entrée.Value = ActiveSheet.Cells(LigneActive, "D").Value UserForm2.Puht.Value = ActiveSheet.Cells(LigneActive, "E").Value UserForm2.Pvte.Value = ActiveSheet.Cells(LigneActive, "G").Value UserForm2.Dlc.Value = ActiveSheet.Cells(LigneActive, "J").Value UserForm2.TextBox_Stock.Value = ActiveSheet.Cells(LigneActive, "F").Value UserForm2.TextBox_Etat.Value = ActiveSheet.Cells(LigneActive, "I").Value UserForm2.TextBox_Sortie.Value = ActiveSheet.Cells(LigneActive, "H").Value   Exit Sub   Erreur: MsgBox ("Requête non trouvée !"), vbRetryCancel + vbExclamation   If Response = Retry Then   Désignation.Text = "" Entrée.Text = "" Puht.Text = "" Pvte.Text = "" Dlc.Text = "" TextBox_Stock = "" TextBox_Etat = "" TextBox_Sortie = ""   Désignation.SetFocus   End If End Sub

---

salut
au lieux d'utiliser un goto trouve, tu peux placer "trouve" a l'interieur de ta boucle if, et ne pas mettre le exit sub, ainsi quelquesoit le résultat de la recherche, il passera en revue toutes les lignes, et trouvera une deuxieme valeur si elle existe

Slt, pour ma part j'utiliserais une collection, la collection est une matrice quin'acceptent que les données uniques, execution tres rapide voila je me le code :

Code:

---

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

Sub recherch()   Dim Plage As Range Dim Tableau(), Resultat() As String Dim i As Integer, j As Integer, m As Integer Dim Un As Collection Dim Doublons As String   Set Un = New Collection   If UserForm2.Désignation.Text = "" Then MsgBox "Vous devez saisir une Recherche", vbCritical End If       'La plage de cellules à tester Set Plage = Range("A1:A" & Range("A65536").End(xlUp).Row) Tableau = Plage.Value ReDim Preserve Resultat(2, 1)   On Error Resume Next   'boucle sur la plage à tester For i = 4 To Plage.Count   'Utilise une collection pour rechercher les doublons '(les collections n'acceptent que des données uniques) Un.Add Tableau(i, 1), Tableau(i, 1) 'S'il y a une erreur (donc presence d'un doublon)   If Err <> 0 Then   If UCase(Range("A" & i)) Like "*" & UCase(UserForm2.Désignation.Value) & "*" Then   UserForm2.Désignation.Value = ActiveSheet.Cells(i, "A").Value UserForm2.Entrée.Value = ActiveSheet.Cells(i, "D").Value UserForm2.Puht.Value = ActiveSheet.Cells(i, "E").Value UserForm2.Pvte.Value = ActiveSheet.Cells(i, "G").Value UserForm2.Dlc.Value = ActiveSheet.Cells(i, "J").Value UserForm2.TextBox_Stock.Value = ActiveSheet.Cells(i, "F").Value UserForm2.TextBox_Etat.Value = ActiveSheet.Cells(i, "I").Value UserForm2.TextBox_Sortie.Value = ActiveSheet.Cells(i, "H").Value   End If Next i End Sub

---

salut ferronimus
moi j'ai rien contre, mais je vois pas le rapport avec la question.
Sting ne veux pas éliminer les doublon, au contraire, il veut les visualiser.

petite remarque...

Code:

---

ActiveSheet.Activate

---

Tu active la feuille active ??

Citation:

---

Envoyé par LeForestier

Tu active la feuille active ??

---

On n'est jamais trop prudent :lol: