recherche par lettres en ComboBox..

kahlouch

XLDnaute Occasionnel
bonjour
puis-je ajouter la fonction recherche par lettres en ComboBox1 et ComboBox2
sur ce fichier
 

Pièces jointes

  • rech.xlsm
    26 KB · Affichages: 9

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
>mais c'est la même chose que j'ai dans mon fichier

Non!



Dans le fichier joint, je n'ai mis que le ComboBox2 en recherche intuitive.
On peut frapper les premières lettres du nom de la spécialité ou du code spécialité.

VB:
Dim choix1()
Private Sub UserForm_Initialize()
    Set f = Sheets("Don-Specialtte")
    choix1 = f.Range("A3:F" & f.Range("A65536").End(xlUp).Row).Value
    Me.ComboBox2.List = choix1
End Sub

Private Sub ComboBox2_Change()
     Dim b()
     tmp = UCase(Me.ComboBox2) & "*"
     n = 0
     For i = LBound(choix1) To UBound(choix1)
       If UCase(choix1(i, 1)) Like tmp Or UCase(choix1(i, 2)) Like tmp Then
         n = n + 1: ReDim Preserve b(1 To 6, 1 To n)
         For k = 1 To 6: b(k, n) = choix1(i, k): Next k
       End If
      Next i
      If n > 0 Then
        Me.ComboBox2.Column = b
        Me.ComboBox2.DropDown
      Else
        Me.ComboBox2.Clear
      End If
End Sub

Private Sub ComboBox2_click()
   Me.TextBox1 = Me.ComboBox2.Column(1)
   Me.TextBox2 = Me.ComboBox2.Column(2)
   Me.TextBox3 = Me.ComboBox2.Column(3)
   Me.TextBox4 = Me.ComboBox2.Column(4)
   Me.TextBox5 = Me.ComboBox2.Column(5)
End Sub

Boisgontier
 

Pièces jointes

  • Copie de rech.xlsm
    56.4 KB · Affichages: 10
Dernière édition:

kahlouch

XLDnaute Occasionnel
>mais c'est la même chose que j'ai dans mon fichier

Non!



Dans le fichier joint, je n'ai mis que le ComboBox2 en recherche intuitive.
On peut frapper les premières lettres du nom de la spécialité ou du code spécialité.

VB:
Dim choix1()
Private Sub UserForm_Initialize()
    Set f = Sheets("Don-Specialtte")
    choix1 = f.Range("A3:F" & f.Range("A65536").End(xlUp).Row).Value
    Me.ComboBox2.List = choix1
End Sub

Private Sub ComboBox2_Change()
     Dim b()
     tmp = UCase(Me.ComboBox2) & "*"
     n = 0
     For i = LBound(choix1) To UBound(choix1)
       If UCase(choix1(i, 1)) Like tmp Or UCase(choix1(i, 2)) Like tmp Then
         n = n + 1: ReDim Preserve b(1 To 6, 1 To n)
         For k = 1 To 6: b(k, n) = choix1(i, k): Next k
       End If
      Next i
      If n > 0 Then
        Me.ComboBox2.Column = b
        Me.ComboBox2.DropDown
      Else
        Me.ComboBox2.Clear
      End If
End Sub

Private Sub ComboBox2_click()
   Me.TextBox1 = Me.ComboBox2.Column(1)
   Me.TextBox2 = Me.ComboBox2.Column(2)
   Me.TextBox3 = Me.ComboBox2.Column(3)
   Me.TextBox4 = Me.ComboBox2.Column(4)
   Me.TextBox5 = Me.ComboBox2.Column(5)
End Sub

Boisgontier
bonjour
je ne sais pas comment te remercier merci pour votre aide