bonjour à tous!!!
j'ai élaboré un code me permettant de remplacer le filtre automatique à l'aide d'une userform.
ce filtrage se fait selon 7 critère.
ma userform marche très bien mais comme mon tableau fait (pour l'instant) 6000 lignes le filtrage me prend 50sec:c'est beaucoup trop long!! et le temps se ralonge avec le nombre de ligne.
je vous fait par de mon code ci joint.
là j'avoue que je peine
j'ai bien essayé de déclarer mes variables, de stopper le scintillement de l'écran...) mais le gain de temps et négligeable.
même l'apparition de la userform prend 15 sec ( car j'élimine les doublons).
si quelqu'un a une proposition pour rendre mon code plus fonctionnel,je le remercie par avance;
et merci à tous car c'est grace à vous que j'ai établis cette userform.
voici mon code:
Private Sub bouton_annulation_Click()
UserForm1.Hide
Unload UserForm1
' auteur:David Ananian
End Sub
Private Sub UserForm_Initialize()
Dim Dbase1 As New Collection
Dim Item
Dim cell As Range
With Worksheets("feuil1" )
On Error Resume Next
For Each cell In Range("G12:G" & .Range("G65536" ).End(xlUp).Row)
If cell <> "" Then
Dbase1.Add cell.Text, cell.Text
End If
Next cell
End With
For Each Item In Dbase1
ComboBox1.AddItem Item
Next Item
Dim Dbase2 As New Collection
With Worksheets("feuil1" )
On Error Resume Next
For Each cell In Range("K12:K" & .Range("K65536" ).End(xlUp).Row)
If cell <> "" Then
Dbase2.Add cell.Text, cell.Text
End If
Next cell
End With
For Each Item In Dbase2
ComboBox2.AddItem Item
Next Item
Dim Dbase3 As New Collection
With Worksheets("feuil1" )
On Error Resume Next
For Each cell In Range("C12:C" & .Range("C65536" ).End(xlUp).Row)
If cell <> "" Then
Dbase3.Add cell.Text, cell.Text
End If
Next cell
End With
For Each Item In Dbase3
ComboBox3.AddItem Item
Next Item
Dim Dbase4 As New Collection
With Worksheets("feuil1" )
On Error Resume Next
For Each cell In Range("D12:D" & .Range("D65536" ).End(xlUp).Row)
If cell <> "" Then
Dbase4.Add cell.Text, cell.Text
End If
Next cell
End With
For Each Item In Dbase4
ComboBox4.AddItem Item
Next Item
Dim Dbase5 As New Collection
With Worksheets("feuil1" )
On Error Resume Next
For Each cell In Range("L12:L" & .Range("L65536" ).End(xlUp).Row)
If cell <> "" Then
Dbase5.Add cell.Text, cell.Text
End If
Next cell
End With
For Each Item In Dbase5
ComboBox5.AddItem Item
Next Item
Dim Dbase6 As New Collection
With Worksheets("feuil1" )
On Error Resume Next
For Each cell In Range("M12:M" & .Range("M65536" ).End(xlUp).Row)
If cell <> "" Then
Dbase6.Add cell.Text, cell.Text
End If
Next cell
End With
For Each Item In Dbase6
ComboBox6.AddItem Item
Next Item
Dim Dbase7 As New Collection
With Worksheets("feuil1" )
On Error Resume Next
For Each cell In Range("N12:N" & .Range("N65536" ).End(xlUp).Row)
If cell <> "" Then
Dbase7.Add cell.Text, cell.Text
End If
Next cell
End With
For Each Item In Dbase7
ComboBox7.AddItem Item
Next Item
' auteur:David Ananian
End Sub
Private Sub bouton_OK_Click()
On Error Resume Next
Application.ScreenUpdating = False
If ComboBox1.Value = "tous" Then
Range("G12" ).AutoFilter field:=7
Else
Range("G12" ).AutoFilter field:=7, Criteria1:=ComboBox1.Value
End If
If ComboBox2.Value = "tous" Then
Range("K12" ).AutoFilter field:=11
Else
Range("K12" ).AutoFilter field:=11, Criteria1:=ComboBox2.Value
End If
If ComboBox3.Value = "tous" Then
Range("C12" ).AutoFilter field:=3
Else
Range("C12" ).AutoFilter field:=3, Criteria1:=ComboBox3.Value
End If
If ComboBox4.Value = "tous" Then
Range("D12" ).AutoFilter field:=4
Else
Range("D12" ).AutoFilter field:=4, Criteria1:=ComboBox4.Value
End If
If ComboBox5.Value = "tous" Then
Selection.AutoFilter field:=12
Else
Range("feuil1!L12" ).AutoFilter field:=12
Range("feuil1!L12:L65536" ).NumberFormat = "0"
Range("feuil2!A1" ).Value = ComboBox5.Value
Range("feuil2!A1" ) = CDate(ComboBox5.Value)
Range("feuil2!A1" ).NumberFormat = "dd/mm/yy"
Range("feuil2!A1" ).Font.ColorIndex = 35
Range("L12" ).AutoFilter field:=12, Criteria1:=Range("feuil2!A1" )
Range("L12" ) = ""
End If
If ComboBox5.Value = "non émise" Then
Range("feuil1!L12" ).AutoFilter field:=12, Criteria1:=Empty
End If
If ComboBox6.Value = "tous" Then
Range("M12" ).AutoFilter field:=13
Else
Range("feuil1!M12" ).AutoFilter field:=13
Range("feuil1!M12:M65536" ).NumberFormat = "0"
Range("feuil2!B1" ).Value = ComboBox6.Value
Range("feuil2!B1" ) = CDate(ComboBox6.Value)
Range("feuil2!B1" ).NumberFormat = "dd/mm/yy"
Range("feuil2!B1" ).Font.ColorIndex = 35
Range("M12" ).AutoFilter field:=13, Criteria1:=Range("feuil2!B1" )
Range("M12" ) = ""
End If
If ComboBox6.Value = "non levée" Then
Range("feuil1!M12" ).AutoFilter field:=13, Criteria1:=Empty
End If
If ComboBox7.Value = "tous" Then
Range("N12" ).AutoFilter field:=14
Else
Range("feuil1!N12" ).AutoFilter field:=14
Range("feuil1!N12:N65536" ).NumberFormat = "0"
Range("feuil2!C1" ).Value = ComboBox7.Value
Range("feuil2!C1" ) = CDate(ComboBox7.Value)
Range("feuil2!C1" ).NumberFormat = "dd/mm/yy"
Range("feuil2!C1" ).Font.ColorIndex = 35
Range("M12" ).AutoFilter field:=14, Criteria1:=Range("feuil2!C1" )
Range("M12" ) = ""
End If
If ComboBox7.Value = "non contrôlée" Then
Range("feuil1!L14" ).AutoFilter field:=14, Criteria1:=Empty
End If
Range("feuil1!L12:L65536" ).NumberFormat = "dd/mm/yy"
Range("feuil1!M12:M65536" ).NumberFormat = "dd/mm/yy"
Range("feuil1!N12:N65536" ).NumberFormat = "dd/mm/yy"
Range("A12" ).Select
ActiveCell.FormulaR1C1 = "tous"
Selection.AutoFill Destination:=Range("A12:Q12" ), Type:=xlFillDefault
' auteur:David Ananian
Unload UserForm1
End Sub
