Encore un listBox ... avec doublons!

Byfranck

XLDnaute Occasionnel
Bien le bonjour à tous,

je bosse pour me faire un Usf pour faire une rechercher un mot, une expression ... dans une base de donnée.

Grâce à beaucoups de patience et beaucoup d'aide des amis du forum, ma base de données et vraiment fonctionnelle et ... luxueuse (3 meg) sans les données!

j'ai récement changé la façon de rechercher les entrées (en cherchant uniquement sur une colonne= les noms clients) pour que ça tourne plus vite. depuis j'ai un autre problème car je dois créer un Usf qui recherche de façon plus large un mot, une expression ... dans une base de données (1 ligne = 1 client avec toutes ses infos jusqu'en colonne 250 (IQ) ).

J'ai trouvé des exemples dans le Forum et j'essai de les adapter.
mon idée est de lancer une recherche depuis un Texbox et d'afficher les résultats trouvés (lignes), il y a des choses qui ressemblent mais dès que je veux changer un paramètre je galère des heures pour que ça fonctionne.
Rien que pour réussir à limiter la recherche à la feuille Feuil1 ... une bonne partie de l'après-midi (ne riez pas!)

Ci-joint un début qui fonctionne, mais qui me pose un problème: je n'arrive pas à éviter les doublon (si dans une ligne une occurence à été trouvée je voudrais afficher cette ligne et on continuer à remplir la Listbox)

Si vous tester faite une recherche avec : RL
vous comprendrez mon problème.

Pour des question "pratiques" j'aurais préféré afficher dans un listview .. mais bon un Listbox c'est déjà pas si mal.


C'est peut être 5 min pour quelqu'un qui s'y connait .. Alors si quelqu'un a un peu de temps et de courrage .. il me sauvera une partie du weekend !


Merci d'avance
Cordialement
Franck
 

Pièces jointes

  • ByFranck _V3.xls
    47.5 KB · Affichages: 110
Dernière édition:

youky(BJ)

XLDnaute Barbatruc
Re : Encore un listBox ... avec doublons!

salut ByFranck,
voici avec un tout petit rajout.....
A+
Code:
'ICI C'est le Moteur de Recherche
Private Sub CommandButton1_Click()
Dim F As Worksheet
Dim Plage As Range, C As Range
Dim T As String, Firstaddress As String
Dim x As Integer
Dim lig As Integer
    ListBox1.Clear
    T = Me.TextBox1
    If T = "" Then Exit Sub
    For Each F In Worksheets
        With F
            Set Plage = Application.Intersect(.UsedRange.Cells, .Range(.Cells(8, 1), .Cells(.Rows.Count, .Columns.Count)))
        End With
        Set C = Plage.Find(T, LookIn:=xlValues, LookAt:=xlPart)
        If Not C Is Nothing Then
            Firstaddress = C.Address
            Do
                With ListBox1
              [B]  If C.Row = lig Then GoTo boucle[/B] 
                   .AddItem F.Name
                    [B]lig = C.Row[/B]
                    For x = 1 To 10
                        .List(.ListCount - 1, x - 1) = F.Cells(C.Row, x).Text
                    Next x
                    .List(.ListCount - 1, 9) = C.Address(False, False)
[B]boucle:[/B]
                End With
                Set C = Plage.FindNext(C)
            Loop While Not C Is Nothing And C.Address <> Firstaddress
        End If
    Next F
    
    If ListBox1.ListCount = 0 Then
        MsgBox "Le Texte " & T & " n'a pas été trouvé" & vbLf & "Faites un essai sur une partie du nom", vbCritical, Sign
    End If
End Sub
 

Byfranck

XLDnaute Occasionnel
Re : Encore un listBox ... avec doublons!

Bonsoir Youki,

merci pour ce "petit" rajout !
je viens de faire un test sur ma base tout semblait ok jsqu'aux dernière lignes:
il y avait quelques lignes assez fantaisistes en fin de listbox qui sont: en cherchant un peu j'ai vu que vous aviez supprimer l'obligation de se limiter à la Feuil1.
C'est modifié et c'est super ça fonctionne à merveille!
merci beaucoup et bonne fin de soirée

Demon cotôté je ne lache pas le morceau une listview serait plus pratique pour pouvoir avoir la possibilité de classer en cliquant sur les headers ..

@+ c
Cordialement
Franck
 
Dernière édition:

bqtr

XLDnaute Accro
Re : Encore un listBox ... avec doublons!

Bonjour Franck, youki(BJ)

Voici un exemple avec une Listview :
Code:
Private Sub CommandButton3_Click()
Dim F As Worksheet
Dim Plage As Range, C As Range
Dim T As String, Firstaddress As String
Dim x As Integer, k As Long, m As Long, n As Long, j As Byte, q As Variant
Dim lig As Integer
Dim Tablo()
    ListView1.ListItems.Clear
    T = Me.TextBox1
    If T = "" Then Exit Sub
    n = 1
      For Each F In Worksheets
          With F
             Set Plage = Application.Intersect(.UsedRange.Cells, .Range(.Cells(8, 1), .Cells(.Rows.Count, .Columns.Count)))
          End With
          Set C = Plage.Find(T, LookIn:=xlValues, LookAt:=xlPart)
            If Not C Is Nothing Then
                Firstaddress = C.Address
                Do
                  If C.Row = lig Then GoTo boucle
                    ReDim Preserve Tablo(0 To 12, 0 To k)
                    Tablo(0, k) = F.Name
                      For x = 1 To 11
                        Tablo(x, k) = F.Cells(C.Row, x).Text
                      Next
                    Tablo(12, k) = C.Address(False, False)
                    lig = C.Row
                    k = k + 1
boucle:
                  Set C = Plage.FindNext(C)
                Loop While Not C Is Nothing And C.Address <> Firstaddress
            End If
      Next F
 
      On Error Resume Next
        q = UBound(Tablo, 2)
      On Error GoTo 0
 
      If IsEmpty(q) Then
        MsgBox "Le Texte " & T & " n'a pas été trouvé" & vbLf & "Faites un essai sur une partie du nom", vbCritical, Sign
        Exit Sub
      End If
 
      For m = 0 To UBound(Tablo, 2)
        ListView1.ListItems.Add , , Tablo(0, m)
        For j = 1 To 12
          ListView1.ListItems(n).ListSubItems.Add Text:=Tablo(j, m)
        Next
        n = n + 1
      Next     
End Sub

Dans ton code pour la Listbox il y a des choses bizarres à mon sens :

-Tu déclares 11 colonnes dans la Listbox et tu n'en dimensionnes que 10.
-Si la recherche est positive, tu mets dans la 1ère colonne le nom de la feuille. Ensuite avec ta boucle tu remplaces cette donnée par le nom du client.
-Même chose pour la dernière colonne, tu remplaces la dernière valeur chargée par l'adresse de la cellule.

A+
 

Pièces jointes

  • ByFranck _V3.zip
    30.1 KB · Affichages: 54
  • ByFranck _V3.zip
    30.1 KB · Affichages: 54
  • ByFranck _V3.zip
    30.1 KB · Affichages: 51
Dernière édition:

Byfranck

XLDnaute Occasionnel
Re : Encore un listBox ... avec doublons!

Bonjour Youki et bqtr,

Bqtr vous m'avez coupé l'herbe sous le pied ... j'essayait de régler le problème de mon côté
merci pour le fichier avec listview qui toune nickel.

je mets en ligne une version avec les 2 solutions: ListBox ou Listview ... ça pourra peut être servir à d'autre utilisateurs novices comme moi. (je suis tellement content quand je trouve une solution applicable à mes problèmes)

Cordialement
Franck
 

Pièces jointes

  • ByFranck _V5.zip
    23.5 KB · Affichages: 52

Byfranck

XLDnaute Occasionnel
Re : Encore un listBox ... avec doublons!

Rebonjour à tous,

Voila en pièce jointe une nouvelle demande d'aide! :rolleyes:

Dans le fichier il y a 3 Usf.
UserFormListviewCh est celui qui vient d'être construit.
UserForm7 est un Usf existant dans dans ma base de données.
=> un double click et par une recherche faite sur la colonneA il m'ouvre la fiche du client (Usf résultat que j'ai simplifié: en réel il a 147 textbox et combobox)

Mon problème est que je voudrais garder l'UserForm7 et y ajouter la fonctionnalité recherche par le mot entré dans un textbox comme dans UserFormListviewCh.

Je ne suis pas certain que ce soit possible de mixer les 2 Usf car si j'ai bien compris dans le code généré par youki puis bqtr (UserFormListviewCh), le tableau listview est redimenssioné à chaque fois.
D'autre part dans l'Usf UserFormListviewCh est-ce nécessaire de récupérer le nom de la feuille et la ref de la cellule? (j'ai essyé d'adapter le code dblclick mais ça ne marche pas)

Merci d'avance pour votre aide et vos conseils

Cordialement
Franck
 

Pièces jointes

  • ByFranck _V6.zip
    47.1 KB · Affichages: 70
Dernière édition:

Statistiques des forums

Discussions
312 793
Messages
2 092 154
Membres
105 241
dernier inscrit
Mixlsm