Discussion :

[Aurélien13140]

Bonjour à tous,

Je souhaite faire une recherche par mot clé via un userform. Cette recherche a pour source une base de donnée située sur la feuille "memory" dans les colonnes situées en HB et HE (soit 4 colonnes).
La recherche s'affiche dans une listbox divisée en 4 colonnes.
Peu importe dans quelle colonne de ma base de donnée se situe ma recherche, je souhaite toujours afficher dans ma listbox "colonne1 = HB" "colonne 2 = HC" "colonne3 = HD" "colonne 4 = HE".

J'ai codé quelque chose qui fonctionne très bien, mais un tant soit un peu lourd.
Il existe probablement une méthode pour allèger le code, mais mes connaissances en VBA sont encore trop limitée.

Quelqu'un peut m'aider? Merci beaucoup

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
Option Explicit
Dim TypeRecherche As String, TypeAction As String, MotCle As String
Dim DerLignArt As Long, i As Long
 
Private Sub userform_activate()
    ''' Dernière ligne occupée par un article '''
    DerLignArt = Sheets("memory").Range("HB65000").End(xlUp).Row - 1
 
    ListBox1.ColumnCount = 4     'Définit le nombre de colonnes dans la ListBox
    ListBox1.ColumnWidths = "60;60;80;100"     'Définit la largeur des colonnes d'une ListBox:
End Sub
 
Private Sub CommandButton6_Click() 'recherche article
    ListBox1.Clear  'Listbox qui affiche la recherche
    Dim c
    MotCle = TextBox3.Value  'Textbox pour écrire le mot clé
    With Sheets("memory").Range("HB4:HE" & DerLignArt)  'selection de la source pour la recherche
        Set c = .Find(MotCle, lookAt:=xlPart)
            If Not c Is Nothing Then  'Si le mot cherché existe
                firstAddress = c.Address
                offsetrech = c.Column - 209
                    For i = 1 To 4
                        If offsetrech = i Then
                            Do
                                With ListBox1
                                    If i = 1 Then
                                        .AddItem
                                        .List(.ListCount - 1, i - 1) = c
                                        .List(.ListCount - 1, i) = c.Offset(0, 1)
                                        .List(.ListCount - 1, i + 1) = c.Offset(0, 2)
                                        .List(.ListCount - 1, i + 2) = c.Offset(0, 3)
                                    ElseIf i = 2 Then
                                        .AddItem
                                        .List(.ListCount - 1, i - 2) = c.Offset(0, -1)
                                        .List(.ListCount - 1, i - 1) = c
                                        .List(.ListCount - 1, i) = c.Offset(0, 1)
                                        .List(.ListCount - 1, i + 1) = c.Offset(0, 2)
                                    ElseIf i = 3 Then
                                        .AddItem
                                        .List(.ListCount - 1, i - 2) = c.Offset(0, -2)
                                        .List(.ListCount - 1, i - 2) = c.Offset(0, -1)
                                        .List(.ListCount - 1, i - 1) = c
                                        .List(.ListCount - 1, i) = c.Offset(0, 1)
                                    ElseIf i = 4 Then
                                        .AddItem
                                        .List(.ListCount - 1, i - 3) = c.Offset(0, -3)
                                        .List(.ListCount - 1, i - 2) = c.Offset(0, -2)
                                        .List(.ListCount - 1, i - 2) = c.Offset(0, -1)
                                        .List(.ListCount - 1, i - 1) = c
                                    End If
                               End With
                            Set c = .FindNext(c)
                            Loop While Not c Is Nothing And c.Address <> firstAddress
                        End If
                    Next
            Else 'Si le mot recherché n'existe pas
                MsgBox "ah ah ah!!!"
            End If
    End With
End Sub

[Invité]

Bonjour,

Regardez cette méthode proposée dans ce post : formule-reconnaitre-matricule-ecrire-automatiquement-nom

[boisgontierjacques]

Bonsoir,


Je ne suis pas sûr d'avoir compris la question.
En PJ, une recherche Multi-mots multi-colonnes dans un seul Textbox.

Boisgontier

[Aurélien13140]

Bonjour Eric, Jacques,

Merci pour vos réponses. La solution proposé par Jacques correspondent quasi totalement à ce que je recherchais.
Par contre, j'ai encore du mal à comprendre le code, mais je vais travailler dessus afin de me l'approprier.

Merci encore à vous 2.

Cordialement

[boisgontierjacques]

Bonjour,

Autre exemple en PJ: Recherche multi-mots multiple

-Plusieurs recherches séparées par ,
-plusieurs mots séparés par espace

Ex: armoire peint , balance personne

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
Dim f, Choix()
Private Sub UserForm_Initialize()
   Set f = Sheets("bd")
   Choix = Application.Transpose(f.Range("a2:a" & f.[A65000].End(xlUp).Row))
   Me.ListBox1.List = Choix
End Sub
 
Private Sub TextBox1_Change()
   Set d1 = CreateObject("scripting.dictionary")
   mots = Split(Trim(Me.TextBox1), ",")
   For Each m In mots
     mots2 = Split(Trim(m), " ")
     tbl = Choix
     For i = LBound(mots2) To UBound(mots2)
       tbl = Filter(tbl, mots2(i), True, vbTextCompare)
     Next i
     For i = LBound(tbl) To UBound(tbl): d1(tbl(i)) = "": Next i
   Next m
   Me.ListBox1.List = d1.keys
End Sub

Boisgontier