Accélérer programmation VBA

[Colombine]

Bonjour à tous,

j'ai un petit problème de vitesse d'éxécution sur une de mes programmations. J'aimerais que ce programme soit plus rapide, je n'ai peut être pas été judicieuse dans ma programmation, pouvez vous m'aider?

Résumé de ce que je veux :
Feuille 1 : ma colonne D contient des enregistrements ( exemple :T1, T2,T3,T4)
Feuille 2 : pour chaque ligne de ma feuille, si ma colonne B ne contient ni T1, ni T2 , ni T3 , ni T4 , je supprime la ligne.

Voici le programme que j'ai fait :

Sub macro1()

Dim i, nblign As Integer
Dim var1, var2, var3, var4 As String

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Sheets("Feuill1").Select

If Cells(3, 4) <> "" Then var1 = Cells(3, 4)
If Cells(4, 4) <> "" Then var2 = Cells(4, 4)
If Cells(5, 4) <> "" Then var3 = Cells(5, 4)
If Cells(6, 4) <> "" Then var4 = Cells(6, 4)

Sheets("Feuill2").Select
nblign = ActiveSheet.UsedRange.Rows.Count
i = nblign
For i = nblign To 2 Step -1
Cells(i, 2).Select
If Selection <> var1 And Selection <> var2 And Selection <> var3 And Selection <> var4 Then
Rows(i).Delete
End If
Next i

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Voilà, si quelqu'un à une petite idée, je suis preneuse.
Merci à tous par avance

 

[VDAVID]

Re : Accélérer programmation VBA

Bonjour tout le monde,

Ci-joint le fichier modifié, il était décalé car ton module n'avait pas l'Option Base 1
J'ai aussi rajouter la prise ne compte des entêtes qui se trouve en ligne 1
Bonne journée !

 

[Herdet]

Re : Accélérer programmation VBA

La mienne c'est :

Sub Macro1()
With Feuil2.[G2].Resize(Feuil2.UsedRange.Rows.Count - 1)
   On Error Resume Next
   .FormulaR1C1 = "=MATCH(RC2,Feuil1!R3C4:R6C4,0)"
   .SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete
   .FormulaR1C1 = "=MATCH(RC3,Feuil1!R3C5:R6C5,0)"
   .SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete
   .ClearContents
   End With
End Sub

Bonjour Dranreb,
Voilà une solution qui me plait bien car il vaut mieux traiter des blocs de cellules plutôt que faire du séquentiel en VBA toujours très long.
J'ai eu il y a 4 mois un problème à régler sur 39500 lignes et 32 colonnes et la méthode INDEX, EQUIV, combinée avec un filtre multiple sur 15 de ces colonnes à été la plus efficace pour faire du traitement de formats et valeurs.

Ce qui est étonnant c'est que dans l'aide en ligne d'Excel 2007 / 2010, la définition du n° 16 et autres n'est plus expliquée (comme en Excel 2003) 😕 et il faut faire un enregistrement des macros pour voir apparaitre les n°

Pour les néophytes du SpecialCells par la méthode manuelle :
- sélectionner la plage de cellules concernées, faire [F5], Cellules, puis sélectionner Formules et cocher Erreurs
- pour vérifier le VBA pas à pas avant suppression de lignes, on peut remplacer .Delete par .Select🙂

Pour Colombine :
Attention à bien gérer les références de cellules et ne pas les déplacer dans Feuil1, l'idéal serait d'utiliser des noms de plages de cellules au lieu de Feuil1!R3C4:R6C4 ou similaire par exemple en définissant T_param1 = Feuil1!R3C4:R50C4 et T_param2 = Feuil1!R3C5:R50C5

A+
Robert

 

[Colombine]

Re : Accélérer programmation VBA

Bonsoir à tous,
merci pour toutes ces réponses et explications aussi variées les unes que les autres.
je vais tester toutes vos solutions et voir laquelle réponds le mieux à mes besoins car là c'était un essai sur quelques enregistrements mais les fichiers que je vais traiter ensuite sont beaucoup plus lourds.

Merci Vdavid pour tes explications , je ne connaissais pas le redim maintenant c'est fait.

Je vous tiendrais au courant mais maintenant ça ne sera que pour septembre , je pars en vacances 😎

Merci encore à vous.
Colombine

 

[Staple1600]

Re : Accélérer programmation VBA

Bonjour à tous

Parce qu'il n'y a pas que le VBA dans Excel 😉

Si vraiment le dieu VBA doit ici être honoré alors voici mon obole

Sub Macro1()
' Macro enregistrée le 10/08/2013 par PCbisSTAPLE
'Déclaration variable
Dim DerLig As Long
'On se place se la feuille2
With Worksheets("Feuil2")
'détermine numéro de ligne de la dernière cellule non vide en colonne B
    DerLig = .Cells(Application.Rows.Count, "B").End(xlUp).Row
    'formule utilisée comme critère dans le filtre élaboré
    .[D2].FormulaR1C1 = "=AND(RC[-2]<>Feuil1!R[1]C,RC[-2]<>Feuil1!R[2]C,RC[-2]<>Feuil1!R[3]C,RC[-2]<>Feuil1!R[4]C)"
    'application du filtre élaboré
    .Range("A1:B" & DerLig).AdvancedFilter _
        Action:=xlFilterInPlace, _
        CriteriaRange:=.Range("D1:D2"), _
        Unique:=False
'ici ajouter le code  pour supprimer le résultat du filtre
End With
End Sub