Recherche intuitive

Bonjour Forum,

Comment adapter cette fonction pour en faire une recherche intuitive?

Private Function SearchString(mysearch As String, mylist As Variant) As Long
    Dim itm As Variant, idx As Long: idx = 0
    If IsArray(mylist) Then
        For Each itm In mylist
            If mysearch = itm Then
                SearchString = idx: Exit Function
            End If
            idx = idx + 1
        Next
        SearchString = -1
    End If
End Function
Private Sub TextBox1_Change()

    Dim i As Long
    i = SearchString(TextBox1.Value, Me.ListBox3.List)
    If i <> -1 Then Me.ListBox3.Selected(i) = True
End Sub

Merci

Bonjour,

Vous pourriez faire la recherche sur la plage de cellules qui alimente le ListBox

par exemple:

n = Sheets("Feuil2").Range("B:B").Find(What:=Me.TextBox1, After:=Range("B1"), LookAt:=xlPart, MatchCase:=False).Row
Me.ListBox1.Selected(n) = True

Merci, mais ce n'est pas une plage de cellules qui alimente ma listbox.

C'est une liste de fichiers xls dans un dossier donné.

La recherche se fait dans un Array a().

Il faut alimenter cet Array par la liste des fichiers.

Ceuzin

Merci beaucoup, des que j'ai une minute je test!

Très gentil!

Merci pour l'aide mais malheureusement je n'arrive pas à le faire fonctionner.

Voici comment ma listbox est alimentée:

Private Sub UserForm_Initialize()
Dim repertoire1 As String, fichier1 As String
Dim NomFichier As String
NomFichier = UserForm12.Label11.Caption
repertoire1 = Thisworkbook.path & "\Save_Devis_Excel\Devis\PDF\"

fichier1 = Dir(repertoire1 & NomFichier & "*.pdf")
Do While fichier1 <> ""
    ListBox1.AddItem fichier1
    fichier1 = Dir
Loop

End Sub

Le UserForm12.Label11.Caption est caché mais dans ce cas ca donne: Cloutier

Ce que j'aimerais faire c'est taper un numéro de devis et que la list s'actualise jusqu'à ce que j'obtienne le bon numéro (certains clients ont plus de 100 devis)

Je crois que ton dernier exemple fonctionnerait mais je ne sais pas comment adapter le code.

J'ai essayé:

Dim a() '--------------------
Private Sub UserForm_Initialize()
Dim repertoire1 As String, fichier1 As String
Dim NomFichier As String
NomFichier = UserForm12.Label11.Caption
repertoire1 = Thisworkbook.path & "\Save_Devis_Excel\Devis\PDF\"

fichier1 = Dir(repertoire1 & NomFichier & "*.pdf")
Do While fichier1 <> ""
    ListBox1.AddItem fichier1
    fichier1 = Dir
Loop
  a = Me.Listbox1.List  '--------------------
End Sub
'------------------ essaie
Private Sub Textbox1_Change()
 If Me.Listbox1.ListIndex = -1 And IsError(Application.Match(Me.Listbox1, a, 0)) Then
   Me.Listbox1.List = Filter(a, Me.Textbox1.Text, True, vbTextCompare)

  End If
End Sub
Dim Tbl()
Dim Enable_event As Boolean
Option Compare Text
Private Sub UserForm_Initialize()
  If Me.répertoire = "" Then Me.répertoire = ThisWorkbook.Path
  nf = Dir(Me.répertoire & "\*.*")
  n = 0
  Do While nf <> ""
    n = n + 1
    ReDim Preserve Tbl(1 To n)
    Tbl(n) = nf
    nf = Dir
  Loop
  If n > 0 Then Me.ListBox1.List = Tbl
 End Sub

Private Sub TextBox2_Change()
     Dim b()
     tmp = Me.TextBox2 & "*"
     n = 0
     For i = LBound(Tbl) To UBound(Tbl)
       If Tbl(i) Like tmp Then n = n + 1: ReDim Preserve b(1 To n):  b(n) = Tbl(i)
     Next i
     If n > 0 Then Me.ListBox1.List = b
End Sub

Ceuzin

intuitif

Bonjour,

voici une solution avec l'opérateur Like

Private Sub TextBox1_Change()
    For i = 1 To Me.ListBox3.ListCount
      m = ListBox3.List(i)
        If m Like (Me.TextBox1 & "*") Then  'Si valeur trouvée
            Me.ListBox3.Selected(i) = True
            Exit For
        End If
    Next
End Sub

Merci à tous ceux et celles qui ont particité à ce sujet.

J'ai retenu la solution de sabv.

Suite à une légère modification elle répond parfaitement à ce que je cherchais, et de plus, elle est ULTRA-SIMPLE.

Private Sub TextBox1_Change()
Dim m
Dim i
    For i = 1 To Me.ListBox3.ListCount
      m = ListBox3.List(i)
      On Error Resume Next '-------------- AJOUT
        If m Like ("*" & Me.TextBox1 & "*") Then  'AJOUT de "*" avant Me.Textbox1
           Me.ListBox3.Selected(i) = True
            Exit For
        End If
    Next
End Sub

Merci!!!


***** EDIT ***** ------------------------------------------

ceuzin j'ai vu que tu avais mis du code pour m'aider à l'intégration, chose que j'ai fait et cela fonctionne parfaitement, au final j'aime mieux ta méthode car elle permet de vider le reste de la listbox.

Dans la solution de sabv, l'item se sélectionnait, j'aimais bien ca, je vais tenter d'intégrer cela à ta solution!

Rechercher des sujets similaires à "recherche intuitive"