Recherche intuitive textBox et affichage dans listbox avec condition

Version imprimable

27/03/2019, 14h03
Osaka2017

1 pièce(s) jointe(s)

Recherche intuitive textBox et affichage dans listbox avec condition

Bonjour à toutes et à tous,

J'ai réalisé un formulaire qui permet d'effectuer une recherche intuitive depuis un textBox et d'afficher le résultat dans la listbox.

La listbox ne peut afficher que les lignes dont la valeur en colonne V est égale à "9999".

Si je tape 2 avec recherche par code suite, la listbox m'affiche bien 3 lignes.

Par contre, si je n'encode rien ,la listbox m'affiche 1.916 lignes, ce qui n'est pas correct. Elle devrait m'en afficher 4 !

Pouvez-vous d'une part, m'éclairer à ce sujet et d'autre part, m'indiquer si les procédures utilisées sont cohérentes et optimales ?

Dans le fichier joint, j'ai du restreindre le nombre de lignes de la base de données originale (50.000 lignes sur 25 colonnes).

Merci à vous pour votre précieuse aide et conseils.
27/03/2019, 16h45
boisgontierjacques

1 pièce(s) jointe(s)

Bonjour,

Fait en 3 mn avec un pgm générique

Boisgontier
18/04/2019, 17h20
Osaka2017

Désolé pour la réponse tardive....Merci Jacques :)

Cependant, avec une BD originale de plus de 50.000 lignes, je souhaiterais pouvoir, depuis un textbox, effectuer une recherche du type "*" & Me.ComboBox2 & "*" et ce, quelle que soit la colonne de recherche (code, dénomination...).

Pourriez-vous m'éclairer ?

Merci d'avance

2 pièce(s) jointe(s)

Bonsoir,

Exemple de recherche multi-mots multi-colonnes:

Fait avec un pgm générique(Il faut adapter ces lignes)

Code:

1
2
3
4
   Set f = Sheets("THESES")
   ColVisu = Array(1, 2, 3, 4, 5, 6)       ' colonnes à visualiser
   colInterro = Array(1, 2, 3, 4, 5)       ' colonnes à interroger
   Set Rng = f.Range("A2:F" & f.[a65000].End(xlUp).Row)

Code:

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
Dim f, choix(), Rng, BD(), Ncol, ColVisu()
Private Sub UserForm_Initialize()
   Set f = Sheets("THESES")
   ColVisu = Array(1, 2, 3, 4, 5, 6)       ' colonnes à visualiser
   colInterro = Array(1, 2, 3, 4, 5)       ' colonnes à interroger
   Set Rng = f.Range("A2:F" & f.[a65000].End(xlUp).Row)
   BD = Rng.Value
   Ncol = UBound(ColVisu) + 1
   '-- en têtes de colonne ListBox
   x = Me.ListBox1.Left + 8
   Y = Me.ListBox1.Top - 12
   For Each k In ColVisu
     Set Lab = Me.Controls.Add("Forms.Label.1")
     Lab.Caption = f.Cells(1, k)
     Lab.Top = Y
     Lab.Left = x
     x = x + f.Columns(k).Width * 0.9
     temp = temp & f.Columns(k).Width * 0.9 & ";"
   Next
   temp = Left(temp, Len(temp) - 1)
   Me.ListBox1.ColumnCount = UBound(ColVisu) + 1
   Me.ListBox1.ColumnWidths = temp
   '---
   ReDim choix(1 To UBound(BD))
   For i = LBound(BD) To UBound(BD)
     For Each k In colInterro
       choix(i) = choix(i) & BD(i, k) & "|"
     Next k
   Next i
   '--- valeurs initiales dans ListBox
   Dim Tbl(): ReDim Tbl(1 To UBound(BD), 1 To Ncol)
   For i = 1 To UBound(BD)
      C = 0
      For Each k In ColVisu
        C = C + 1: Tbl(i, C) = BD(i, k)
      Next k
   Next i
   'TriMultiCol Tbl, LBound(Tbl), UBound(Tbl), 1
   Me.ListBox1.List = Tbl
   Me.Label1.Caption = Me.ListBox1.ListCount & " Ligne(s)"
End Sub
 
Private Sub TextBox1_Change()
  If Me.TextBox1 <> "" Then
     mots = Split(Trim(Me.TextBox1), " ")
     Tbl = choix
     For i = LBound(mots) To UBound(mots)
        Tbl = Filter(Tbl, mots(i), True, vbTextCompare)
     Next i
     If UBound(Tbl) > -1 Then
        Dim b(): ReDim b(1 To UBound(Tbl) + 1, 1 To Ncol)
        For i = LBound(Tbl) To UBound(Tbl)
          a = Split(Tbl(i), "|")
          For k = 1 To Ncol: b(i + 1, k) = a(k - 1): Next k
        Next i
        Me.ListBox1.List = b
        Me.Label1.Caption = UBound(Tbl) + 1 & " Ligne(s)"
     Else
        Me.ListBox1.Clear
     End If
  Else
     UserForm_Initialize
  End If
End Sub

Pièce jointe 468221

Boisgontier

19/04/2019, 16h27
Osaka2017

Merci pour votre retour rapide Jacques.

Après adaptation, le code fonctionne mais il manque encore un filtre important (voir mon premier post).

La Listbox ne peut afficher que les lignes dont la valeur en colonne V est égale à "9999" ->

Code:

Application.WorksheetFunction.CountIf(FL2.Range("S2:S" & FL2.Range("F" & Rows.count).End(xlUp).Row), "=9999")

Je n'arrive pas à insérer cette condition dans le code fourni.

Vincent

1 pièce(s) jointe(s)

>La Listbox ne peut afficher que les lignes dont la valeur en colonne V est égale à "9999"

-C'est curieux, sur votre fichier, je ne vois pas de 9999 en colonne V.
-Il suffit de filtrer la table BD()

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Option Compare Text
Private Sub UserForm_Initialize()
  Set f = Sheets("bd")
  BD = f.Range("A2:D" & f.[A65000].End(xlUp).Row).Value
  ville = "Paris"
  Set Rng = f.Range("C2:C" & f.[C65000].End(xlUp).Row)
  n = Application.CountIf(Rng, ville)
  Dim TblDest(): ReDim TblDest(1 To n, 1 To UBound(BD, 2))
  j = 0
  For i = 1 To UBound(BD)
    If BD(i, 3) = ville Then
      j = j + 1
      For k = 1 To UBound(BD, 2): TblDest(j, k) = BD(i, k): Next k
    End If
  Next i
  Me.ListBox1.ColumnCount = 4
  Me.ListBox1.ColumnWidths = "50;30;30;50"
  Me.ListBox1.List = TblDest
End Sub

Boisgontier

19/04/2019, 19h33
Osaka2017

Merci Jacques :)

Effectivement, dans le fichier original il s'agit de la colonne V alors que dans le fichier joint dans mon post, il s'agit de la colonne S :)

Votre code fonctionne bien mais je n'arrive pas à l'intégrer dans votre précédent code (recherche multi-mots multi-colonnes).

Merci pour votre aide en tous cas :)

Vincent

1 pièce(s) jointe(s)

J'ai pris tous les codes de la colonne s<>9999
Pour prendre les codes égaux à 9999 If bd2(i, 19) =code Then

Code:

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
Dim f, choix(), Rng, BD(), Ncol, ColVisu()
Private Sub UserForm_Initialize()
   Set f = Sheets("BD")
   ColVisu = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22) ' colonnes à visualiser
   colInterro = Array(1, 2, 3, 4, 5, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22) ' colonnes à interroger
   '-----
   Set Rng = f.Range("A2:Y" & f.[A65000].End(xlUp).Row)   'adapter
   code = 9999                                            ' adapter
   bd2 = Rng.Value
   Set Rng2 = f.Range("S2:S" & f.[S65000].End(xlUp).Row)   ' adapter
   n = UBound(bd2) - Application.CountIf(Rng2, code)
   Dim BD(): ReDim BD(1 To n, 1 To UBound(bd2, 2))
   j = 0
   For i = 1 To UBound(bd2)
    If bd2(i, 19) <> code Then                             ' adapter
      j = j + 1
      For k = 1 To UBound(bd2, 2): BD(j, k) = bd2(i, k): Next k
    End If
  Next i
  '---
   Ncol = UBound(ColVisu) + 1
   '-- en têtes de colonne ListBox
   x = Me.ListBox1.Left + 8
   Y = Me.ListBox1.Top - 12
   For Each k In ColVisu
     Set Lab = Me.Controls.Add("Forms.Label.1")
     Lab.Caption = f.Cells(1, k)
     Lab.Top = Y
     Lab.Left = x
     x = x + f.Columns(k).Width * 0.9
     temp = temp & f.Columns(k).Width * 0.9 & ";"
   Next
   temp = Left(temp, Len(temp) - 1)
   Me.ListBox1.ColumnCount = UBound(ColVisu) + 1
   Me.ListBox1.ColumnWidths = temp
   '---
   ReDim choix(1 To UBound(BD))
   For i = LBound(BD) To UBound(BD)
     For Each k In colInterro
       choix(i) = choix(i) & BD(i, k) & "|"
     Next k
   Next i
   '--- valeurs initiales dans ListBox
   Dim Tbl(): ReDim Tbl(1 To UBound(BD), 1 To Ncol)
   For i = 1 To UBound(BD)
      C = 0
      For Each k In ColVisu
        C = C + 1: Tbl(i, C) = BD(i, k)
      Next k
   Next i
   'TriMultiCol Tbl, LBound(Tbl), UBound(Tbl), 1
   Me.ListBox1.List = Tbl
   Me.Label1.Caption = Me.ListBox1.ListCount & " Ligne(s)"
End Sub
 
Private Sub TextBox1_Change()
  If Me.TextBox1 <> "" Then
     mots = Split(Trim(Me.TextBox1), " ")
     Tbl = choix
     For i = LBound(mots) To UBound(mots)
        Tbl = Filter(Tbl, mots(i), True, vbTextCompare)
     Next i
     If UBound(Tbl) > -1 Then
        Dim b(): ReDim b(1 To UBound(Tbl) + 1, 1 To Ncol)
        For i = LBound(Tbl) To UBound(Tbl)
          a = Split(Tbl(i), "|")
          For k = 1 To Ncol: b(i + 1, k) = a(k - 1): Next k
        Next i
        Me.ListBox1.List = b
        Me.Label1.Caption = UBound(Tbl) + 1 & " Ligne(s)"
     Else
        Me.ListBox1.Clear
     End If
  Else
     UserForm_Initialize
  End If
End Sub

Boisgontier

23/04/2019, 14h51
Osaka2017

Merci Jacques ;)

Après avoir adapté n = UBound(bd2) - Application.CountIf(Rng2, code) en n = Application.CountIf(Rng2, code), le code fonctionne parfaitement.

Est-il possible de faire la recherche uniquement dans les 4 premières colonnes (colInterro = Array(1, 2, 3, 4)) au lieu de faire le recherche dans toutes les colonnes visualisées (1 à 22) ?

Merci à vous
23/04/2019, 18h48
boisgontierjacques

1 pièce(s) jointe(s)

Bonjour,

cf PJ

Boisgontier
25/04/2019, 10h27
Osaka2017

Fonctionne à merveille !

Merci Jacques pour votre aide et votre rapidité de réponse :)