Discussion :

[Marc31]

Bonjour, j'ai trouvé du code vba pour faire une fonction recherche et j'aimerais l'adapter à ma base mais je n'y arrive pas donc je viens ici pour avoir un peu d'aide,MERCI!

J'ai mis une image de ma base

Voici le code

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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
Option Explicit
 
Option Compare Text 'la casse n'est pas prise en compte
 
Private Sub ComboBox1_Change()
 
Dim d1 As Object
Dim d2 As Object
Dim d3 As Object
Dim w As Worksheet, derlig&, t1, t2, t3, i&
 
ComboBox2.RowSource = "": ComboBox3.RowSource = "": ComboBox4.RowSource = ""
 
Union([Type_structure], [Nom_structure], [Ville_pro]).ClearContents
 
If Application.CountIf([Type_structure], ComboBox1) = 0 Then _
  ComboBox1 = "": ComboBox1.DropDown: GoTo 1
 
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set d3 = CreateObject("Scripting.Dictionary")
Set w = Sheets("Feuille_BDD")
 
w.AutoFilterMode = False
 
derlig = w.Range("K65536").End(xlUp).Row
 
t1 = Application.Transpose(w.Range("C3:C" & derlig))
t2 = Application.Transpose(w.Range("D3:D" & derlig))
t3 = Application.Transpose(w.Range("E3:E" & derlig))
 
For i = 1 To UBound(t1)
 
  If w.Cells(i + 2, "K") = ComboBox1 Or w.Cells(i + 2, "K") = "Type_structure" Then
 
    If t1(i) <> "" And Not d1.exists(t1(i)) Then d1.Add t1(i), t1(i)
    If t2(i) <> "" And Not d2.exists(t2(i)) Then d2.Add t2(i), t2(i)
    If t3(i) <> "" And Not d3.exists(t3(i)) Then d3.Add t3(i), t3(i)
 
  End If
 
Next
'---RowSources---
If d1.Count Then
  [Nom_structure].Resize(d1.Count) = Application.Transpose(d1.items)
  [Nom_structure].Sort [Nom_structure], xlAscending, Header:=xlNo
  ComboBox2.RowSource = "Nom_structure"
End If
If d2.Count Then
  [Ville_pro].Resize(d2.Count) = Application.Transpose(d2.items)
  [Ville_pro].Sort [Ville_pro], xlAscending, Header:=xlNo
  ComboBox3.RowSource = "Ville_pro"
End If
If d3.Count Then
  [Email_pro].Resize(d3.Count) = Application.Transpose(d3.items)
  [Email_pro].Resize(, 2).Sort [Email_pro].Offset(, 1), xlAscending, [Email_pro], , xlDescending, Header:=xlNo
  ComboBox4.RowSource = "Email_pro"
End If
'--------
1 Recherche
End Sub
 
Private Sub ComboBox2_Change() 'Type
Recherche
End Sub
 
Private Sub ComboBox3_Change() 'Thème
Recherche
End Sub
 
Private Sub ComboBox4_Change() 'Numéro
Recherche
End Sub
 
Private Sub Label6_Click() 'recherche mot clé
ComboBox1 = ""
TextBox1.SetFocus
TextBox1.SelStart = 0
TextBox1.SelLength = Len(TextBox1)
Recherche
End Sub
 
Private Sub Label7_Click() 'RAZ
ComboBox2 = "": ComboBox3 = "": ComboBox4 = ""
End Sub
 
 
Private Sub TextBox1_Change()
If TextBox1 = "" Then Recherche
End Sub
 
 
Private Sub UserForm8_Initialize()
Union([Nom_structure], [Ville_pro], [Email_pro_pro]).ClearContents
With ListView1.ColumnHeaders
  .Add , , "", 0
  .Add , , "Type_structure", 300
  .Add , , "Nom_structure", 300
  .Add , , "Ville_pro", 300
  .Add , , "Email_pro", 300
  .Add , , "Impression", 100
End With
End Sub
 
Sub Recherche()
Dim w As Worksheet, derlig&, i&, motclé As Boolean
With ListView1
  .ListItems.Clear
  If ComboBox1 = "" And TextBox1 = "" Then Exit Sub
  Set w = Sheets("Feuille_BDD")
  derlig = w.[K65536].End(xlUp).Row
  For i = 3 To derlig
    motclé = False
    If TextBox1 <> "" Then motclé = _
      Not Intersect(w.[J:J,N:N], w.Rows(i)).Find(TextBox1, , xlValues, xlPart) Is Nothing
    If motclé Or TextBox1 = "" _
      And (ComboBox1 = w.Cells(i, "K") Or w.Cells(i, "K") = "Type_structure") _
      And (ComboBox2 = "" Or ComboBox2 = w.Cells(i, "C")) _
      And (ComboBox3 = "" Or ComboBox3 = w.Cells(i, "D")) _
      And (ComboBox4 = "" Or ComboBox4 = w.Cells(i, "E")) Then
      .ListItems.Add , , ""
      .ListItems(.ListItems.Count).ListSubItems.Add = w.Cells(i, "H")
      .ListItems(.ListItems.Count).ListSubItems.Add = w.Cells(i, "K")
      .ListItems(.ListItems.Count).ListSubItems.Add = w.Cells(i, "M")
      .ListItems(.ListItems.Count).ListSubItems.Add = w.Cells(i, "N")
      .ListItems(.ListItems.Count).ListSubItems.Add = Format(w.Cells(i, "O"), "dd/mm/yy")
      .ListItems(.ListItems.Count).ListSubItems.Add = w.Cells(i, "S")
    End If
  Next
End With
End Sub

Bonne journée

[Daniel.C]

Bonjour,

Apparemment, ton code fais autre chose qu'une fonction de recherche. Si tu définissais ton besoin ?

[Marc31]

En fait je veux selectionner dans une premiere liste deroulante, une valeur qui s'affiche dans une lsitbox puis on peut choisir des valeurs dans d'autres listes deroultanes ce qui fait changer la listbox!
Mon fichier excel est composé de deux feuilles Feuilles_acteurs, où il y a les boutons et la feuille_BDD où il y toutes les données.
J'ai mis une image d'un userform pour voir ce que je veux en fait!
Merci et bonne journée