Option Explicit Option Compare Text Private Inscrits() As String Private Rsts() As String Private Sub Form_Initialize() ReDim Inscrits(0 To 6) Inscrits(1) = "Tata" Inscrits(2) = "Titi" Inscrits(3) = "Toto" Inscrits(4) = "Totou" Inscrits(5) = "Tutu" Inscrits(6) = "Tu" ReDim Rsts(0 To 0) End Sub Private Sub tSél_Change() Dim Txt As String, i As Long, n As Long Txt = tSél.Text Rsts = Résultats(Txt, Inscrits) n = UBound(Rsts) tRst.Caption = "": tRsts.Clear If n = 1 Then tRst.Caption = Rsts(1) Else For i = 1 To n tRsts.AddItem (Rsts(i)) Next i End If End Sub Private Sub tRsts_Click() Dim r As Integer r tRsts.ListIndex: tRst.Caption tRsts.List(r): tRsts.Clear End Sub Private Function Résultats(Txt As String, Lst() As String) As String() Dim Rsts() As String, IndI As Long, IndS As Long Dim Ok As Boolean, i As Long, n As Long ReDim Rsts(0 To 0) If Len(Txt) > 0 Then IndI IndiceInférieur(Txt, Lst): IndS IndiceSupérieur(Txt, Lst) Ok = ((IndI > 0) And (IndS > 0)) If Ok Then n = IndS - IndI + 1 ReDim Rsts(0 To n) For i = 1 To n Rsts(i) = Lst(IndI + i - 1) Next i End If Résultats = Rsts End Function Private Function IndiceInférieur(Txt As String, Lst() As String) As Long Dim n As Long, Ind As Long, a As Long, b As Long, c As Long, p As Long n UBound(Lst): Ind 0: p = Len(Txt) a 1: b n Do If b - a = 1 Then Exit Do c = Int((a + b) / 2): If Txt <= Left(Lst(c), p) Then b = c Else a = c Loop If Txt = Left(Lst(a), p) Then Ind = a ElseIf Txt = Left(Lst(b), p) Then Ind = b End If IndiceInférieur = Ind End Function Private Function IndiceSupérieur(Txt As String, Lst() As String) As Long Dim n As Long, Ind As Long, a As Long, b As Long, c As Long, p As Long n UBound(Lst): Ind 0: p = Len(Txt) a 1: b n Do If b - a = 1 Then Exit Do c = Int((a + b) / 2): If Txt >= Left(Lst(c), p) Then a = c Else b = c Loop If Txt = Left(Lst(b), p) Then Ind = b ElseIf Txt = Left(Lst(a), p) Then Ind = a End If IndiceSupérieur = Ind End Function
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question