Code pour recherche avancée

Version imprimable

bonjour forum.
j'ai écris ce code
Code:

1 2 3 4 Sheets("source").Range("af2") = "*" & Me.T_rech_nom 'code pour la recherche avanc?e Range("Tab_1[#All]").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _ Range("Tableau3[[#All],[NOM & PRENOMS]]"), CopyToRange:=Range("Ai1:Bk1"), _ Unique:=False
qui me permet de faire le filtre avancé. j'ai utilisé l'enregistrement de macro et le filtre avancé de excel. mais voila que quand je saisie une recherche dans le textbox ça met trop de temps à charger et à le transposer dans la listbox. y a t'il une autre façon de faire la recherche?
je note que j'ai deux textbox dont rech_classe et rech_nom( je peux saisir deux recherches à la fois ou bien une seule recherche. exemple: je cherche tous les élèves en classe de CM2 ou bien je cherche un élève du nom de CHRIST EDEN*en classe de CM2 [si il y a d'autres élèves avec le même nom dans d'autres classes ] )
merci de m'aider

21/08/2018, 12h49
boisgontierjacques

Bonjour,

Dans le pgm ci-joint, il suffit de frapper eden chris cm2 dans le TextBox.

La recherche intuitive est multi-mots (désordre) et multi-colonnes.

Boisgontier
21/08/2018, 13h03
Mr l'Ashanti

1 pièce(s) jointe(s)

Citation:

Envoyé par boisgontierjacques

Bonjour,

Dans le pgm ci-joint, il suffit de frapper eden chris cm2 dans le TextBox.

La recherche intuitive est multi-mots (désordre) et multi-colonnes.

Boisgontier

merci mais si vous le permettez je vous envoie mon fichier pour une lucidité. la page 2 et 3 c'est dans ces pages que je voudrais faire la recherche. j'avais déjà lu votre fichier joint mais cette fois j'ai ajouter d'autres parametres a mon formulaire donc j'ai du abandonné l'ancien. ouvrez le formulaire userform_enreg. merci

1 pièce(s) jointe(s)

Citation:

Envoyé par boisgontierjacques

Bonjour,

Dans le pgm ci-joint, il suffit de frapper eden chris cm2 dans le TextBox.

La recherche intuitive est multi-mots (désordre) et multi-colonnes.

Boisgontier

Bonjour jacques. j'ai essayé d'adapter ton code à mon formulaire.

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
Dim mots As Variant, tbl As Variant
Dim I As Integer, a(), j As Integer, c As Integer
 
 If Me.T_rech_nom <> "" Then
     mots = Split(Trim(Me.T_rech_nom), " ")
     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 NbCol + 1)
        For I = LBound(tbl) To UBound(tbl)
          a = Split(tbl(I), "|")
          j = a(NcolInt)
          For c = 1 To NbCol: b(I + 1, c) = BD(j, c): Next c
          b(I + 1, c) = j
        Next I
        Me.ListBox1.List = b
     Else
       Me.ListBox1.Clear
     End If
  Else
     UserForm_Initialize
  End If

lors de l'exécution j'ai ce message: l'indice n'appartient pas à la sélection
formulaire:userform_enreg(page 3 et page 4)
merci pour ton aide

Bonsoir,

-Je n'interviens pas sur des pgm déjà écrits
-La solution la + simple est d'appeler un formulaire indépendant
-Ci joint le moteur de la recherche intuitive multi-mots multi-colonnes sans la modif,ajout, sup.

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
 
Option Compare Text
Dim f, NomTableau, BD(), choix(), NcolInt, colVisu(), colInterro(), NbCol
Private Sub UserForm_Initialize()
   NomTableau = "Tableau1"                                ' à Adapter
   NbCol = Range(NomTableau).Columns.Count
   BD = Range(NomTableau).Resize(, NbCol + 1).Value       ' Array: + rapide
   For i = 1 To UBound(BD): BD(i, NbCol + 1) = i: Next i  ' No enregistrement
   '--- à adapter
   colInterro = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13) ' colonnes à interroger (adapter)
   colVisu = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13)    ' colonnes à visualiser dans listbox (adapter)
   '----
   NcolInt = UBound(colInterro) + 1
   Me.ListBox1.ColumnCount = NbCol + 1
   '-- 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
   '--- valeurs initiales dans ListBox
   Dim Tbl(): ReDim Tbl(1 To UBound(BD), 1 To NbCol + 1)
   For i = 1 To UBound(BD)
        For c = 1 To NbCol: Tbl(i, c) = BD(i, c): Next c
        Tbl(i, c) = BD(i, NbCol + 1)
   Next i
   Me.ListBox1.List = Tbl
   Me.ListBox1.ListIndex = -1
End Sub
 
Private Sub TextBoxRech_Change()
  If Me.TextBoxRech <> "" Then
     mots = Split(Trim(Me.TextBoxRech), " ")
     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 NbCol + 1)
        For i = LBound(Tbl) To UBound(Tbl)
          a = Split(Tbl(i), "|")
          j = a(NcolInt)
          For c = 1 To NbCol: b(i + 1, c) = BD(j, c): Next c
          b(i + 1, c) = j
        Next i
        Me.ListBox1.List = b
     Else
       Me.ListBox1.Clear
     End If
  Else
     UserForm_Initialize
  End If
End Sub

Boisgontier

31/08/2018, 02h17
Mr l'Ashanti

merci