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
| Private Sub CBNomCtc_Change()
i = 0
EntreeNom = CBNomCtc.Text
Nblignes = Sheets("BDD Contact").Range("A65536").End(xlUp).Row + 1
'Recherche de correspondance entre le Text de la combo et la base de données de clients
With Sheets("BDD Contact").Range("D2:D" & Nblignes)
Set c = .Find(EntreeNom, LookIn:=xlValues)
Set Plage = Nothing
If Not c Is Nothing Then
firstAddress = c.Address
Do
Set a = c.Offset(columnoffset:=-2)
If a.Value = NumSte Then
If Not Plage Is Nothing Then
Set Plage = Application.Union(Plage, c)
Else
Set Plage = c
End If
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
'Traitement correspondance
If Not Plage Is Nothing Then
ReDim Tab1(1 To Plage.Count, 1)
For Each Cell In Plage
i = i + 1
Tab1(i, 0) = Cell
Next
'Attribution de la liste (et c'est là que ça coince!!!)
CBNomCtc.List = Tab1
'Classement par ordre alphabétique
For i = LBound(CBNomCtc.List, 1) To UBound(CBNomCtc.List, 1) - 1
For j = i + 1 To UBound(CBNomCtc.List, 1)
If CBNomCtc.List(i, 0) > CBNomCtc.List(j, 0) Then
a = CBNomCtc.List(i, 0)
b = CBNomCtc.List(i, 1)
CBNomCtc.List(i, 0) = CBNomCtc.List(j, 0)
CBNomCtc.List(i, 1) = CBNomCtc.List(j, 1)
CBNomCtc.List(j, 0) = a
CBNomCtc.List(j, 1) = b
End If
Next
Next
End If |
Partager