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,