Discussion :

[lumpys]

Bonjour,

J'ai une feuille Excel qui contient 3 colonnes, en A : un N° de client, en B : un nom, en C : un prénom. Ces colonnes ne sont pas triées. A partir de cela, j'ai créé un userform qui contient deux zones de listes pour rechercher des enregistrements : une zone de liste permet de rechercher par N° client, la 2ème permet de rechercher par nom + pénom. Les données de ces 2 zones de listes sont triées.

Je souhaiterais que dès que l'on commence à saisir dans la zone de recherche avec le nom cela réduise la liste. Je l'ai fait pour celle qui permet de rechercher par N° de client cela fonctionne. Par contre je n'arrive pas à faire la même chose dans la zone qui contient le nom + le prénom. Mon problème se situe sur le ChoixNom_Change. Une idée ?

Merci.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
 
Option Compare Text
Dim f, ligneEnreg, ligneEnreg2, Tblclé(), tblBD(), choix1(), ligne
 
Private Sub ChoixNumClient_Click()
 For i = 1 To UBound(choix1)
  If tblBD(i, 1) = ChoixNumClient.Column(0) Then
    ligneEnreg = i
    For Each c In Me.Frame_Civilite.Controls
     If tblBD(ligneEnreg, 4) = c.Caption Then c.Value = True
    Next c
    Me.Controls("TextBox1") = tblBD(ligneEnreg, 1)
    Me.Controls("TextBox2") = tblBD(ligneEnreg, 2)
    Me.Controls("TextBox3") = tblBD(ligneEnreg, 3)
    For k = 4 To 7
        Me.Controls("TextBox" & k) = tblBD(ligneEnreg, k + 1)
      Next k
    End If
  Next i
 
End Sub
 
Private Sub ChoixNumClient_Change()
 If Me.ChoixNumClient.ListIndex = -1 And IsError(Application.Match(Me.ChoixNumClient, choix1, 0)) Then
   ReDim tblChoix1(1 To UBound(choix1))
   tmp = UCase(Me.ChoixNumClient) & "*"
   ligne = 0
   For Each c In choix1
     If UCase(c) Like tmp Then ligne = ligne + 1: tblChoix1(ligne) = c
   Next c
   If ligne > 0 Then
     ReDim Preserve tblChoix1(1 To ligne)
     Call Tri2(tblChoix1, LBound(tblChoix1), UBound(tblChoix1))
     Me.ChoixNumClient.List = tblChoix1
     Me.ChoixNumClient.DropDown
   End If
  Else
   ChoixNumClient_Click
  End If
End Sub
 
Private Sub ChoixNom_Change()
'ListIndex = -1 signifie qu'aucune ligne n'est sélectionnéee
 If Me.ChoixNom.ListIndex = -1 And IsError(Application.Match(Me.ChoixNom, Tblclé, 0)) Then
   choix2 = Application.Transpose(f.Range("B2:B" & f.[a65000].End(xlUp).Row).Value)
   Call Tri2(choix2, LBound(choix2), UBound(choix2))
 
   ReDim tblChoix2(1 To UBound(choix2))
   tmp = UCase(Me.ChoixNom) & "*"
   ligne = 0
   For Each c In tblChoix2
     If UCase(c) Like tmp Then ligne = ligne + 1: tblChoix2(ligne) = c
   Next c
   If ligne > 0 Then
     ReDim Preserve tblChoix2(1 To ligne)
     Call Tri(tblChoix2, LBound(tblChoix2), UBound(tblChoix2))
     Me.ChoixNom.List = tblChoix2
     Me.ChoixNom.DropDown
   End If
  Else
   ChoixNom_click
  End If
End Sub
 
 
Private Sub UserForm_Initialize()
 
  Set f = Sheets("BD")
 
  Tblclé = Range("B2:C" & [a65000].End(xlUp).Row).Value     ' Nom+Prénom
  tblBD = Range("A2:H" & [a65000].End(xlUp).Row).Value      ' BD
  Call Tri(Tblclé, LBound(Tblclé), UBound(Tblclé))
  Me.ChoixNom.List = Tblclé
 
  choix1 = Application.Transpose(f.Range("A2:A" & f.[a65000].End(xlUp).Row).Value)
  Call Tri2(choix1, LBound(choix1), UBound(choix1))
  Me.ChoixNumClient.List = choix1
  ligneEnreg2 = f.[a65000].End(xlUp).Row + 1
  Me.ChoixNumClient.SetFocus
End Sub
Private Sub ChoixNom_click()
 'on récupère tous les champs
 For i = 1 To UBound(Tblclé)
  If tblBD(i, 2) = ChoixNom.Column(0) And tblBD(i, 3) = ChoixNom.Column(1) Then
    ligneEnreg = i
    For Each c In Me.Frame_Civilite.Controls
     If tblBD(ligneEnreg, 4) = c.Caption Then c.Value = True
    Next c
    Me.Controls("TextBox1") = tblBD(ligneEnreg, 1)
    Me.Controls("TextBox2") = tblBD(ligneEnreg, 2)
    Me.Controls("TextBox3") = tblBD(ligneEnreg, 3)
    For k = 4 To 7
        Me.Controls("TextBox" & k) = tblBD(ligneEnreg, k + 1)
      Next k
    End If
  Next i
End Sub
 
 
 
Sub Tri(a(), gauc, droi)  ' Quick sort
  ref = a((gauc + droi) \ 2, 1) & a((gauc + droi) \ 2, 2)
  g = gauc: d = droi
  Do
    Do While a(g, 1) & a(g, 2) < ref: g = g + 1: Loop
    Do While ref < a(d, 1) & a(d, 2): d = d - 1: Loop
    If g <= d Then
       For k = LBound(a, 2) To UBound(a, 2)
         temp = a(g, k): a(g, k) = a(d, k): a(d, k) = temp
       Next k
       g = g + 1: d = d - 1
    End If
  Loop While g <= d
  If g < droi Then Call Tri(a, g, droi)
  If gauc < d Then Call Tri(a, gauc, d)
End Sub
Sub Tri2(c, gauche, droite) ' Quick sort
   ref = c((gauche + droite) \ 2)
   g = gauche: d = droite
   Do
     Do While c(g) < ref: g = g + 1: Loop
     Do While ref < c(d): d = d - 1: Loop
     If g <= d Then
       temp = c(g): c(g) = c(d): c(d) = temp
       g = g + 1: d = d - 1
     End If
   Loop While g <= d
   If g < droite Then Call Tri2(c, g, droite)
   If gauche < d Then Call Tri2(c, gauche, d)
End Sub

[boisgontierjacques]

Bonsoir,

Voir PJ

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Option Compare Text
Dim f, ligneEnreg, choix1(), tblBD()
 
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  tblBD = Range("A2:G" & [A65000].End(xlUp).Row).Value      ' BD
  n = f.[A65000].End(xlUp).Row - 1
  ReDim choix1(1 To n)
  For i = 1 To n
   choix1(i) = tblBD(i, 1) & " " & tblBD(i, 2)
  Next i
  Call Tri(choix1, LBound(choix1), UBound(choix1))
  Me.ChoixNom.List = choix1
End Sub
 
Private Sub Choixnom_Change()
  If Me.ChoixNom.ListIndex = -1 And IsError(Application.Match(Me.ChoixNom, choix1, 0)) Then
   Me.ChoixNom.List = Filter(choix1, Me.ChoixNom.Text, True, vbTextCompare)
   Me.ChoixNom.DropDown
  Else
    ChoixNom_click
  End If
End Sub
 
Private Sub ChoixNom_click()
 'on récupère tous les champs
 For i = 1 To UBound(choix1)
  If tblBD(i, 1) & " " & tblBD(i, 2) = ChoixNom Then
    ligneEnreg = i
    For Each c In Me.Frame_Civilite.Controls
     If tblBD(ligneEnreg, 3) = c.Caption Then c.Value = True
    Next c
    Me.Controls("TextBox1") = tblBD(ligneEnreg, 1)
    Me.Controls("TextBox2") = tblBD(ligneEnreg, 2)
    For k = 3 To 6
        Me.Controls("TextBox" & k) = tblBD(ligneEnreg, k + 1)
      Next k
    End If
  Next i
End Sub

Jacques Boisgontier