Recherche multiple dans la colonne 3 d'une listbox à 3 colonnes discontinues

**goninph** · 21/09/2019, 23h19

Bonjour,

En consultant le site de Monsieur Jacques Boisgontier, j'ai réussi au bout de plusieurs heures à créer une Listbox à 3 colonnes en ne chargeant que 3 colonnes discontinues.

Mais à pésent je suis bloquer avec la Textbox1 pour la recherche.

Dans la colonne 3, j'aimerai effectuer une recherche multiple séparée par des espaces.

Merci pour votre aide.
Philippe

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
Option Explicit
Dim f, TblBD, NbCol, Rng, choix
Private Sub BT_Annuler_Click()
    Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim LargeurCol()
Dim I As Variant
Dim NbCol As Variant
Dim ColVisu()
        Set f = Sheets("DATA_Interventions")
        Set Rng = f.Range("A3:BL" & f.[A65000].End(xlUp).Row) 'étendre la zone selon la dernière colonne choisie dans ColVisu
        ColVisu = Array(2, 1, 7)  'colonne de la feuille : 2=Adresse cellule 1=ID 7=Formule pour affichage Listbox
        LargeurCol = Array(60, 50, 500) 'largeur de colonne, la colonne 3 est sans restriction
        Me.ListBox1.ColumnCount = UBound(ColVisu) + 1
        Me.ListBox1.ColumnWidths = Join(LargeurCol, ";")
        Me.ListBox1.List = Application.Index(Rng, Evaluate("Row(1:" & Rng.Rows.Count & ")"), ColVisu)
 
 
End Sub
Private Sub TextBox1_Change()
Dim Mots, I, Tbl, choix As Variant
                Mots = Split(Trim(Me.TextBox1), " ") ' Permet une recherche multiple, taper les requêtes en séparant par un espace
                Tbl = choix
                For I = LBound(Mots) To UBound(Mots)
                Tbl = Filter(Tbl, Mots(I), True, vbTextCompare)
                Next I
                Me.ListBox1.List = Tbl
End Sub
Private Sub ListBox1_Click()
 
'Utisiser la valeur de la colonne 1
'        Adresse = ActiveCell = Me.ListBox1.List(, 0) 'colonne 1
'        Sheets("DATA_Interventions").Select
'            Range(Adresse).EntireRow.Select 'Déplace le document pour rendre visible l'étiquette, formule à placer dans la colonne : =CELLULE("adresse";B3)
 
'Utisiser la valeur de la colonne 2
    ActiveCell = Me.ListBox1.List(, 2)    ' colonne 2
 
'Utisiser la valeur de la colonne 3
'    ActiveCell = Me.ListBox1.List(, 2)    ' colonne 3
 
Unload Me
End Sub
Function Tableau(Rng) 'Pour charger les colonnes non contigue
  NbLig = Rng.Rows.Count: NbCol = Rng.Areas.Count
  Dim Tbl():  ReDim Tbl(1 To NbLig, 1 To NbCol)
  For I = 1 To NbCol
    For J = 1 To NbLig: Tbl(J, I) = Rng.Areas(I)(J): Next J
  Next I
  Me.ListBox1.List = Tbl
End Function

**goninph** · 22/09/2019, 22h37

Bonjour,

Enfin j'ai trouvé la perle sur un forum (Fichier de Jacques Boisgontier) que j'ai réussi à adapter à mes besoins.

- Choisir la colonne de recherche
- Recherche multiple avec un espace comme séparateur
- Je peux récupérer soit l'ID de la ligne, soit l'adresse de la ligne pour pouvoir récupérer les autres infos des 70 lignes de la DATA, soit une concaténation des colonnes principales

Merci à tous pour votre aide et bonne nuit
Meilleures salutations Philippe

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
Option Compare Text
Dim f, BD(), choix(), Rng, Ncol, NcolInt, colVisu(), colInterro(), Decal
Private Sub UserForm_Initialize()
Dim LargeurCol()
Set f = Sheets("DATA_Interventions")
Set Rng = f.Range("A3:BL" & f.[A65000].End(xlUp).Row) ' BD (1 colonne de plus)
        Me.ListBox1.ColumnCount = 3
        colVisu = Array(1, 2, 7) 'Numéros des colonnes à afficher
        LargeurCol = Array(50, 50, 500) 'largeur des colonnes
        Me.ListBox1.ColumnWidths = Join(LargeurCol, ";")
        colInterro = Array(7) 'Numéros des colonnes dans lesquels rechercher
        Decal = Rng.Row - 1 'Début de la base de donnée
        BD = Rng.Value
        Col = UBound(BD, 2): For I = LBound(BD) To UBound(BD): BD(I, Col) = I + Decal: Next I 'no enreg
        NcolInt = UBound(colInterro) + 1
        Ncol = UBound(colVisu) + 1 'ReDim ancien(1 To 1, 1 To Ncol)
    'Génération de choix()
        ReDim choix(1 To UBound(BD))
        Col = UBound(BD, 2)
        For I = LBound(BD) To UBound(BD)
        For Each K In colInterro
        choix(I) = choix(I) & BD(I, K) & "|"
        Next K
        choix(I) = choix(I) & BD(I, Col) & "|" 'no enreg
        Next I
        TriS choix, 1, UBound(choix)
    'Valeurs initiales dans ListBox
        Dim Tbl(): ReDim Tbl(1 To UBound(BD), 1 To Ncol + 1)
        For I = 1 To UBound(BD)
        c = 0
        For Each K In colVisu
        c = c + 1: Tbl(I, c) = BD(I, K)
        Next K
        c = c + 1: Tbl(I, c) = I + Decal
        Next I
        TriMultiCol Tbl, 1, LBound(Tbl), UBound(Tbl)
        Me.ListBox1.List = Tbl
        Me.ListBox1.ListIndex = -1
Me.TextBox1.SetFocus 'Placer le curseur dans la recherche
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 + 1)
        For I = LBound(Tbl) To UBound(Tbl)
          a = Split(Tbl(I), "|")
          J = a(NcolInt) - 1 - Decal + 1
          For K = 1 To Ncol
            kk = colVisu(K - 1)
            xx = UBound(BD)
            b(I + 1, K) = BD(J, kk)
          Next K
          b(I + 1, K) = J + 1
        Next I
        Me.ListBox1.List = b
     Else
       Me.ListBox1.Clear
     End If
  Else
     UserForm_Initialize
  End If
End Sub
Private Sub ListBox1_Click()
''ID de la ligne Data
'    ActiveCell = Me.ListBox1.List(, 0) 'colonne 1 de ListBox1
 
''Adresse de la ligne Data : Formule à placer dans la colonne B : =CELLULE("adresse";B3)
'        Adresse = Me.ListBox1.List(, 1) 'colonne 2 ListBox1
'        Sheets("DATA_Interventions").Select
'            Range(Adresse).EntireRow.Select 'Déplace le document pour rendre visible l'étiquette
 
'Nom, prénom Rue Ville ... : Formule =CONCATENER() à placer dans la colonne
    ActiveCell = Me.ListBox1.List(, 2) 'colonne 3 ListBox1
Unload Me
End Sub
Sub TriMultiCol(a, ColTri, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2, ColTri)
  g = gauc: d = droi
  Do
    Do While a(g, ColTri) < ref: g = g + 1: Loop
    Do While ref < a(d, ColTri): 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 TriMultiCol(a, ColTri, g, droi)
  If gauc < d Then Call TriMultiCol(a, ColTri, gauc, d)
End Sub
Sub TriS(a, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2)
  g = gauc: d = droi
  Do
     Do While a(g) < ref: g = g + 1: Loop
     Do While ref < a(d): d = d - 1: Loop
     If g <= d Then
        temp = a(g): a(g) = a(d): a(d) = temp
        g = g + 1: d = d - 1
     End If
   Loop While g <= d
   If g < droi Then Call TriS(a, g, droi)
   If gauc < d Then Call TriS(a, gauc, d)
End Sub
Private Sub BT_Annuler_Click()
    Unload Me
End Sub

**goninph** · 23/09/2019, 18h37

Hello,

Avec ce code est il possible de changer le numéro de la colonne à trier ?

Merci pour votre aide
Philippe

Recherche multiple dans la colonne 3 d'une listbox à 3 colonnes discontinues

Excel

Discussions similaires

Partager

Partager