accélération d'un code VBA - VB/VBA/VBS - Programmation
Marsh Posté le 03-08-2005 à 18:33:42
tu mettrais tout ce bordel entre 2 balises code ca serait mieux
Marsh Posté le 04-08-2005 à 15:45:32
Plutot que d'utiliser les additem pour les combobox
ne peux tu pas utiliser les rowsource : ca va t'éviter les boucles
Marsh Posté le 04-08-2005 à 15:47:05
Range("D12" & .Range("D65536" ).End(xlUp).Row)
à remplacer par (si possible)
Range("D12" & .Range("D12" ).End(xldown).Row)
Marsh Posté le 04-08-2005 à 17:19:53
Pour remplir des combobox je te conseille également de faire des tableaux croisés dynamiques pour ne par avoir de répétition dans ta liste et même faire un classement par ordre alphabétique des valeur dans le tableau X dyn.
Si tu suis les trois conseils ça ira vachement plus vite
Marsh Posté le 04-08-2005 à 17:55:44
merci je vai essayé mais je suis pas un expère de VBA voir plutot un débutant qui persévère!!!!
Marsh Posté le 05-08-2005 à 10:00:57
Il peut être plus grave de perdre ses verres...
Marsh Posté le 07-08-2005 à 13:14:32
salut, tu as une autre option pour accéler l'exécution du code qui est la désactivation du recalcul automatique. à n'utiliser bien sur que dans les passages ou tu n'as pas besoin de recalulculer le contenu des cellules.
--> application.Calculation =xlCalculationManual pour mettre en manuel
--> application.Calculation =xlCalculationAutomatic pour remettre en auto
Marsh Posté le 03-08-2005 à 16:46:28
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