Recherche a partir d'une listbox

[kolivier]

Bonjour le forum,

Je vous remercie du temps que vous passerez a lire mon message.

J'ai actuellement une macro :
http://www.listebebe.com/exemple3.zip

J'aimerai que dans la celulle "RECHERCHE" (ident.text), on saisisse un début de numéro et il apparait dans la listbox les premiers numeros qui commence par le nuùero saisies.

J'ai un exemple de bout de code mais je n'arrive pas a l'adapter :


Private Sub ident_Change()
Dim Cell As Range
Dim Recherche As String, Adresse As String
Dim Ligne As Variant
Dim C As Object
Dim data As New Collection
Dim i As Byte
ListBox2.Clear
Recherche = ident.Value
' j'ai tenté de modifier a partir d'ici mais ça bug
Range("C1").Select
Ligne = Range("C" & "65536").End(xlUp).Row
Set Plage = Range("C2:C" & Ligne)
'----------

With Plage
Set C = .Find(Recherche)
If Not C Is Nothing Then
Adresse = C.Address
Do
On Error Resume Next
If UCase(Recherche) = UCase(Left(C, Len(Recherche))) Then
data.Add C, CStr(C)
End If
On Error GoTo 0
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> Adresse
End If
End With

For i = 1 To data.Count
ListBox2.AddItem data(i)
Next i
End sub

merci ENORMEMENT pour toute votre aide.
Je vais essayer de comprendre d'ici la ce code.

Bonne journée a tous les membres du FORUM

 

[Hervé]

Re : Recherche a partir d'une listbox

bonjour kolivier

une proposition en essayant de ne pas trop modifier les codes existants.

en entete de ton module userform place cette ligne (hors procédure) :

Dim tablo

ceci aura pour fonction de déclarer un tableau en public.

dans la procédure d'initialize de ton userform (Private Sub UserForm_Initialize()), rajoute cette ligne à la fin du code :

tablo = ListBox2.List

et enfin, remplace ta macro change par celle-ci :

Private Sub Ident_Change()
Dim tablores()
Dim i As Integer, x As Integer


For i = 0 To UBound(tablo)
    If Mid(tablo(i, 0), 1, Len(Ident)) = Ident Then
        x = x + 1
        ReDim Preserve tablores(1 To 3, 1 To x)
        tablores(1, x) = tablo(i, 0)
        tablores(2, x) = tablo(i, 1)
        tablores(3, x) = tablo(i, 2)
    End If
Next i

If Not x = 0 Then
    ListBox2.Clear
    ListBox2.Column = tablores
End If
End Sub

salut

 

[ChTi160]

Re : Recherche a partir d'une listbox

Salut kolivier
bonjour mon Ami Hervé
arff Hervé tu vas dire mais voilà ce que j'avais fais

Private Sub UserForm_Initialize()
Dim cel As Range, L As Integer

ListBox2.Clear
ListBox2.ColumnCount = 3
ListBox2.ColumnWidths = "40;60;60"
Workbooks.Open ("c:\fichier.xls")
Dim classeurDestination As Workbook
Dim feuilleDestination As Worksheet
Set classeurDestination = Workbooks("fichier.xls")
Set feuilleDestination = classeurDestination.Worksheets("DEMANDES")
With Worksheets("DEMANDES")
Tableau = .Range("B3:BP" & .Range("B65536").End(xlUp).Row).Value
For L = 1 To UBound(Tableau, 1)

ListBox2.AddItem Tableau(L, 1)
ListBox2.List(ListBox2.ListCount - 1, 1) = Tableau(L, 2)
ListBox2.List(ListBox2.ListCount - 1, 2) = Tableau(L, 63)
L = L + 1
Next
End With
End Sub

et

Private Sub ident_Change()
Dim TabResult() As Variant
Dim Recherche As String
Dim Ligne As Variant
Dim C As Object
Dim data As New Collection
Dim i As Byte
Dim x As Integer
x = 0
On Error GoTo fin
If Len(Trim(Ident.Value)) < 1 Then ListBox2.Clear: Exit Sub
  ListBox2.Clear
Recherche = Trim(Ident.Value)

' j'ai tenté de modifier a partir d'ici mais ça bug
For L = 1 To UBound(Tableau, 1)
  If Left(Trim(Tableau(L, 2)), Len(Recherche)) = Recherche Then
      ReDim Preserve TabResult(3, x)
         TabResult(0, x) = Tableau(L, 1)
         TabResult(1, x) = Tableau(L, 2)
         TabResult(2, x) = Tableau(L, 63)
         x = x + 1
  End If
 Next

ListBox2.Column() = TabResult
fin:
End Sub

arff la même chose quoi !!! mais je poste quand même la!!!!
bonne fin de Journée

 

[kolivier]

Re : Recherche a partir d'une listbox

Merci beaucoup Messieurs, et merci a tous ceux qui m'ont lu.

Cela fonctionne parfaitement.

A tout le forum, je vous présente le ZIDANE du https://www.excel-downloads.com/ (pour sa technique pas pour son Age....):

VIVE HERVE, vive ce forum et vive l'équipe de France