Barre de recherche pour trouver une valeur

Bonjour à tous,

Je suis face à un problème dont mes connaissances limitées en VBA font que je bloque dessus.

J'ai mis en place sur un tableau un "moteur de recherche" à l'aide d'une barre de recherche et d'un bouton. En inscrivant un mot dans la barre de recherche puis en cliquant sur le bouton, mes macros vont chercher les cellules dans un tableau, où qu'elles soient.

Or je rencontre 2 obstacles :

1) une colonne avec des date du type 01/01/2019 se trouve dans mon tableau et lorsque j'inscris "01/01/2019" dans ma barre de recherche, cela bloque (je suis certain que c'est à cause des "/" car si je tape juste 01 ou 2019 il n'y a pas de problème ) et je ne sais pas comment y remédier.

2) Lorsque que le moteur de recherche ne trouve pas de cellule comportant le mot taper dans la barre de recherche, plutôt que d'avoir le message "déblocage" qui renvoie au code VBA, je voudrais qu'un message box apparaisse du genre

 MsgBox "Aucune correspondance n'a été trouvée" & vbCrLf & vbCrLf & "Le fichier va se fermer", vbCritical + vbOKOnly, "INTROUVABLE"

Je vous mets ci-dessous mes code pour ma barre de recherche et mon bouton, en espérant que quelqu'un pourra m'aider.

Private Sub CommandButton1_Click()

    Cells.Find(What:=TextBox1.Text, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False).Activate
    On Error Resume Next

End Sub
 

Private Sub Label1_Click()

End Sub

Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    TextBox1.Text = ""
End Sub

Merci d'avance !

Bonjour Serge, bonjour le forum,

Le code ci-dessous fait le job sans textbox ni bouton. Il suffit de le placer dans l'onglet approprié. Puis, dans A1 de cet onglet tu tapes la valeur cherchée :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range

If Range("A1").Value = "" Then Exit Sub
Set R = UsedRange.Find(Range("A1").Value, Range("A1"), , xlPart)
If Not R Is Nothing And R.Address <> "$A$1" Then
    R.Select
Else
    MsgBox "Aucune correspondance n'a été trouvée !", vbCritical + vbOKOnly, "INTROUVABLE": Range("A1").Select
End If
End Subb

Bonjour Thauthème,

Je te remercie pour ta réponse, je vais assurément me servir de ton code pour d'autre fichier. Par contre ici, je dois absolument conserver le textbox et le bouton... et de plus j'ai un macro qui m'actualise les data toutes le 15s donc avec ton code, le Msgbox réapparait toute les 15s.

Et d'ailleurs ensuite l'idée était de mettre un deuxieème textbox lié au même bouton pour avoir donc au final 2 conditions de recherche (le bouton prendrai en compte le textbox 1 puis le textbox 2 s'il n'est pas vide).

As-tu une solution pour moi compte tenu de mes contraintes ?

Je met ci-dessous un tableau à titre d'exemple pour illustrer, l'idée est la suivante :

- si il y a une valeur dans le text box 1 et rien dans le textbox 2, quand on clique sur le bouton ça cible la cellule où se trouve la valuer du textbox 1

(exemple dans le classeur ci-joint : "m" dans textbox 1 --> en cliquant ça doit me cibler la cellule B11 )

- si il y a une valeur dans le text box 1 et aussi dans le textbox 2, quand on clique sur le bouton ça cible la cellule où se trouve la veulre du textbox 2 uniquement sur la ligne où le textbox 1 est présent.

(exemple dans le classeur ci-joint : "01/01/2019" dans textbox 1 et "a" dans textbox 1 --> en cliquant ça doit me cibler la cellule A2 puis en recliquant A4 )

Je ne sais pas si j'arrive à me faire comprendre...

Bonjour,

Essayer cette modification

Private Sub CommandButton1_Click()
    Dim quoi As Variant

    quoi = TextBox1.Text
    If IsDate(TextBox1.Text) Then quoi = CDate(TextBox1.Text)
    If IsNumeric(TextBox1.Text) Then quoi = CDec(TextBox1.Text)

    Cells.Find(What:=quoi, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False).Activate
    On Error Resume Next

End Sub

thev a écrit :

Bonjour,

Essayer cette modification

Private Sub CommandButton1_Click()
    Dim quoi As Variant

    quoi = TextBox1.Text
    If IsDate(TextBox1.Text) Then quoi = CDate(TextBox1.Text)
    If IsNumeric(TextBox1.Text) Then quoi = CDec(TextBox1.Text)

    Cells.Find(What:=quoi, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False).Activate
    On Error Resume Next

End Sub

Bonjour thev,

Merci beaucoup, ça marche parfaitement !!!!

Crois-tu que je pourrai encore abuser des vos talents svp ?

L'idée était de mettre un deuxième textbox lié au même bouton pour avoir donc au final 2 conditions de recherche (le bouton prendrai en compte le textbox 1 en priorité puis le textbox 2 s'il n'est pas vide).

Voyez-vous ce que je veux dire ?

Bonsoir,

D'après ce que j'ai compris, voici un code qui pourrait convenir

Private Sub CommandButton1_Click()
    Dim ctrl As Control, quoi As Variant, recherche_ok As Boolean

    recherche_ok = False
    For Each ctrl In Me.Controls
        If TypeOf ctrl Is MSForms.TextBox Then
            quoi = ctrl.Text
            If IsDate(ctrl.Text) Then quoi = CDate(ctrl.Text)
            If IsNumeric(ctrl.Text) Then quoi = CDec(ctrl.Text)

            If quoi <> Empty Then
                On Error Resume Next
                Cells.Find(What:=quoi, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
                    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                    False).Activate
                If Err.Number = 0 Then recherche_ok = True: Exit For
            End If
        End If
    Next ctrl
    If Not recherche_ok Then MsgBox "Aucune correspondance n'a été trouvée" & vbCrLf & vbCrLf & "Le fichier va se fermer", vbCritical + vbOKOnly, "INTROUVABLE"
End Sub

thev a écrit :

Bonsoir,

D'après ce que j'ai compris, voici un code qui pourrait convenir

Private Sub CommandButton1_Click()
    Dim ctrl As Control, quoi As Variant, recherche_ok As Boolean

    recherche_ok = False
    For Each ctrl In Me.Controls
        If TypeOf ctrl Is MSForms.TextBox Then
            quoi = ctrl.Text
            If IsDate(ctrl.Text) Then quoi = CDate(ctrl.Text)
            If IsNumeric(ctrl.Text) Then quoi = CDec(ctrl.Text)

            If quoi <> Empty Then
                On Error Resume Next
                Cells.Find(What:=quoi, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
                    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                    False).Activate
                If Err.Number = 0 Then recherche_ok = True: Exit For
            End If
        End If
    Next ctrl
    If Not recherche_ok Then MsgBox "Aucune correspondance n'a été trouvée" & vbCrLf & vbCrLf & "Le fichier va se fermer", vbCritical + vbOKOnly, "INTROUVABLE"
End Sub

Bonsoir,

J'ai essayé de tester votre solution mais je bloque sur :

  For Each ctrl In Me.Controls

Vous serait-il possible de me joindre un fichier excel afin que je me rend compte oce que j'ai loupé ?

Et d'ailleurs je ne comprend pas car je ne vois pas où sont les textbox1 et 2 dans votre code....

Bonsoir,

En relisant le post, je pense que au final que le code ci-dessous répondra mieux à votre demande.

Voir exemple ci-joint

Private Sub rechercher_Click()
    Dim arguments(), i As Integer, quoi As Variant, recherche_ok As Boolean

    If TextBox2.Text <> Empty Then arguments = Array(TextBox1.Text, TextBox2.Text) _
    Else arguments = Array(TextBox1.Text)
    recherche_ok = False
    For Each ligne In ActiveSheet.UsedRange.Rows
        For i = LBound(arguments) To UBound(arguments)
            quoi = arguments(i)
            If IsDate(quoi) Then quoi = CDate(quoi): If IsNumeric(quoi) Then quoi = CDec(quoi)
            Set cell = ligne.Find(What:=quoi, LookIn:=xlValues, LookAt:=xlPart)
            If cell Is Nothing Then Exit For
        Next i
        If i > UBound(arguments) Then recherche_ok = True: cell.Activate: Exit For
    Next ligne

    If Not recherche_ok Then MsgBox "Aucune correspondance n'a été trouvée" & vbCrLf & vbCrLf & "Le fichier va se fermer", vbCritical + vbOKOnly, "INTROUVABLE"

End Sub
  

NB: dans le code précédent, la variable objet ctrl correspond à chaque contrôle du formulaire. Cette variable représente donc tour à tour TextBox1 et TextBox2.

Merci Thev,

c'est parfait!