Filtrée les lignes ayant uniquement la valeur 1

Sub Search()
Dim recherche As Object
x = 0
With USF1

If .R1 = "" Or .R2 = "" Then Exit Sub

If Not IsDate(.R1) Or Not IsDate(.R2) Then Exit Sub
.ListBox1.clear
DateDebut = Format(.R1, "00000"): DateFin = Format(.R2, "00000")
End With
Application.ScreenUpdating = False

With Worksheets("BDD")
DerLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
DerCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set rng = .Range(.Cells(2, 1), .Cells(DerLigne, DerCol))
End With
With rng
.Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlGuess
TabGeneral = .Value
End With
For Lgn = 1 To UBound(TabGeneral, 1)
If Format(TabGeneral(Lgn, 3), "00000") >= DateDebut And Format(TabGeneral(Lgn, 3), "00000") <= DateFin And TabGeneral(Lgn, 6) = 1 Then
x = x + 1
ReDim Preserve TabRecup(7, x)
TabRecup(1, x) = TabGeneral(Lgn, 1)
TabRecup(2, x) = TabGeneral(Lgn, 2)
TabRecup(3, x) = TabGeneral(Lgn, 3)
TabRecup(4, x) = TabGeneral(Lgn, 4)
TabRecup(5, x) = TabGeneral(Lgn, 5)
TabRecup(6, x) = TabGeneral(Lgn, 6)


End If

Next Lgn

With USF1.ListBox1
If x > 1 Then
.List = Application.Transpose(TabRecup)
ElseIf x = 1 Then
.Column = Application.Transpose(TabRecup)
End If
End With
End Sub

Cliquez pour agrandir...