Optimiser code VBA par boucle

[Jacques25]

Bonjour à tous,

Je souhaite optimiser un code VBA rendu assez long vu mes maigres connaissance sur le sujet. Ce que j'essai de faire c'est de remplacer ce bout de code :

Range('B1:B250').AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
('J1:J2'), CopyToRange:=Range('J4:J52'), Unique:=True
Range('B1:B250').AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
('K1:K2'), CopyToRange:=Range('K4:K52'), Unique:=True
Range('B1:B250').AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
('L1:L2'), CopyToRange:=Range('L4:L52'), Unique:=True

par une boucle, sachant qu'il y a entre 20 et 30 codes quasi identiques à la suite.
Est ce que c'est possible, si oui pouvez vous m'aider ?
Est ce que les boucles ralentissent ou au contraire accélèrent le fonctionnement d'une macro?

Merci à tous de l'aide que vous pourrez m'apporter.

Jacques

 

[_Thierry]

Bonjour Jacques, le Forum

Assez rapidement sans trop tester, voici une proposition :

Option Explicit

Sub SpecialAdavancedFilterLoop()
Dim PlageSource As Range
Dim PlageCriteria As Range
Dim PlageCible As Range
Dim i As Byte

Set PlageSource = Range('B1:B250')
Set PlageCriteria = Range('I1')
Set PlageCible = Range('I4')


For i = 1 To 30

PlageSource.AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=Range(PlageCriteria.Offset(0, i), PlageCriteria.Offset(1, i)), _
            CopyToRange:=Range(PlageCible.Offset(0, i), PlageCriteria.Offset(48, i)), _
            Unique:=True
Next

End Sub

Bon Week End
[ol]@+Thierry[/ol]

 

[_Thierry]

_Thierry écrit:

Bonjour Jacques, le Forum

Assez rapidement sans trop tester, voici une proposition :

Option Explicit

Sub SpecialAdavancedFilterLoop()
Dim PlageSource As Range
Dim PlageCriteria As Range
Dim PlageCible As Range
Dim i As Byte

Set PlageSource = Range('B1:B250')
Set PlageCriteria = Range('I1')
Set PlageCible = Range('I4')


For i = 1 To 30

PlageSource.AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=Range(PlageCriteria.Offset(0, i), PlageCriteria.Offset(1, i)), _
            CopyToRange:=Range(PlageCible.Offset(0, i), PlageCible.Offset(48, i)), _
            Unique:=True
Next

End Sub

Bon Week End
[ol]@+Thierry[/ol]

EDITION !!!

Petite modif dans le code (trop rapide)

Sinon les boucles, si elles sont bien conçues, peuvent optimiser un code et surtout en faciliter la lecture et la maintenance. Les Set d'Objets (pour PlageSource ici par exemple), évitent aussi à VBA d'aller relire la plage à chaque fois...

 

[Jacques25]

Merci thierry pour ta rapidité, je test ça et te retiens au courant.

@ plus

Jacques

 

[Jacques25]

Encore merci thierry

Ca marche, je ne sais pas si c'est plus rapide, mon PC rame tellement que je ne vois pas la différence.J'ai au moins eu le plaisir d'apprendre quelquechose

@ plus

Jacques