Filtre formulaire
bonsoir
j'ai une feuille DB j'ai créer un formulaire de recherche et je voudrai que quand une certaine case de la DB contient une date la ligne n'apparait pas dans le formulaire de recherche ??
merci beaucoup
bonsoir
voila le code que j'utilise pour afficher le contenu de ma feuille DB dans mon formulaire de recherche, comment faire pour ne pas afficher dans mon formulaire de recherche les lignes dont la colonne C contient une date ?
merci
Dim f, choix(), Rng, BD(), Ncol, ColVisu()
Private Sub Label3_Click()
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub UserForm_Initialize()
Set f = Sheets("DB")
ColVisu = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12) ' colonnes à visualiser
Set Rng = f.Range("A2:N" & f.[a65000].End(xlUp).Row)
BD = Rng.Value
Ncol = UBound(ColVisu) + 1
'-- en têtes de colonne ListBox
x = 22
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
'--
TblTmp = Rng.Value
For i = LBound(BD) To UBound(BD)
ReDim Preserve choix(1 To i)
For Each K In ColVisu
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)"
End If
Else
UserForm_Initialize
End If
End Sub
Bonjour,
Voici un essai avec l'ajout d'une fonction et des petites modifications dans l'ordre d'exécution du code (et ajout de conditions supplémentaires) étant donné qu'il est maintenant possible que votre listbox soit vide si votre colonne C ne contient que des dates.
Dim f, choix(), Rng, BD(), Ncol, ColVisu()
Private Sub Label3_Click()
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub UserForm_Initialize()
Set f = Sheets("DB")
ColVisu = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12) ' colonnes à visualiser
Set Rng = f.Range("A2:N" & f.[a65000].End(xlUp).Row)
'BD = Rng.Value '<<< ligne désactivée ici
Ncol = UBound(ColVisu) + 1
'-- en têtes de colonne ListBox
x = 22
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
'--
'TblTmp = Rng.Value '<<< désactivée car pas de trace dans suite du code
'------------
'-------------
BD = FiltrerDates(Rng.value) '<<<< utilisation ici
if not isempty(BD) then 'chgt ici
For i = LBound(BD) To UBound(BD)
ReDim Preserve choix(1 To i)
For Each K In ColVisu
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
end if 'jusqu'ici
Me.Label1.Caption = Me.ListBox1.ListCount & " Ligne(s)"
End Sub
Private Sub TextBox1_Change()
If Me.TextBox1 <> "" Then
if not isempty(choix) then 'ou BD
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)"
End If
else
Me.Label1.Caption = "0 Ligne(s)"
end if
Else
UserForm_Initialize
End If
End Sub
function FiltrerDates(ArrSrc, optional Column as long = 3)
dim temp()
for i = lbound(ArrSrc) to ubound(ArrSrc)
if not isdate(ArrSrc(i, Column)) then
n = n + 1: redim preserve temp(1 to ubound(ArrSrc, 2), 1 to n)
for k = lbound(ArrSrc, 2) to ubound(ArrSrc, 2)
temp(k, n) = ArrSrc(i, k)
next k
end if
next i
if n > 0 then FiltrerDates = application.transpose(temp)
end function
Cdlt,
merci beaucoup
sa fonctionne mais ou modifier le code pour changer de colonne
merci
j'ai trouver mais pour la colonne O sa ne fonctionne pas
merci
Bonjour,
Actuellement, la colonne O n'est pas prise en compte dans le code :
ColVisu = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12) ' <<< ici les colonnes à visualiser dans la listbox
Set Rng = f.Range("A2:N" & f.[a65000].End(xlUp).Row) '<<< ici la base
Il faut donc changer A2:N par au moins A2:O et pour reporter la colonne O, au moins rajouter (ou modifier) la ligne ainsi :
ColVisu = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 15)
Et si les dates sont en colonne O, il faut modifier cette ligne ainsi :
BD = FiltrerDates(Rng.value, 15) '<<<< 15 devient la colonne contenant des dates qu'on exclut
Dans la fonction FiltrerDates, la colonne contenant les dates est la C (la 3) par défaut car c'est ainsi que vous avez présenté votre problème.
Cdlt,
bonjour
sa fonctionne sauf que si j'ai plusieurs ligne oui il y a des date dans la colonne O il me renvoie une erreur ??
Sur quelle ligne se produit l'erreur et quel est le message ?
Que cherchez-vous à faire exactement cette fois et puis-je voir le code actuel ?
bonjour
sa fonctionne parfaitement dernière petite question est il possible d'avoir une case a cocher pour afficher ou non la colonne ?
merci
Bonjour,
Nickel si ça fonctionne !
Le mieux pour ce second problème serait de créer un nouveau sujet. En tout cas, je pense que c'est possible. Il faudrait essayer, dans un premier temps, de modifier ainsi ces lignes :
Set Chk = Me.Controls.Add("Forms.CheckBox.1")
Chk.Caption = f.Cells(1, K)
Chk.Top = Y
Chk.Left = x
Chk.value = true
Ensuite, il faudra essayer de jouer sur la propriété .columnhidden ou .columnwidth de la listbox...
Je n'ai jamais essayé donc il faudrait que je fasse des tests, d'où la nécessité d'un nouveau sujet qui permettrait plus facilement d'ouvrir la porte à des réponses de membres plus compétents.
Edit : En fait cette solution ne serait pas très pratique à l'utilisation parce qu'elle entrainerait alors un décalage. Je pense qu'il faudrait plutôt réfléchir à autre chose.
Cdlt,