Accélération/alternative boucle for next

Version imprimable

Bonjour,

afin d'automatiser un reporting, j'extrait des tables de notre système de gestion et les importe sur excel. Je dispose donc d'un onglet "CONTRAT" qui contient environ 15000 lignes (ensemble des contrats depuis 2008).
Pour chaque contrat, on a une colonne "nom (ID)", une colonne "date de début" et une colonne "date de fin".

Pour chaque nom (ID) je souhaiterais connaitre les mois pour lesquels il était présent. Pour cela, un usf me permet de saisir une année et lance la boucle suivante :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 annee = cbox_1.Value taille_essai = Application.WorksheetFunction.CountA(Sheets("TABLEAUX").Range("$A:$A")) taille_contrat = Application.WorksheetFunction.CountA(Sheets("CONTRAT").Range("$A:$A")) For i = 2 To taille_essai ste = Sheets("TABLEAUX").Range("A" & i).Value & Sheets("TABLEAUX").Range("B" & i).Value For j = 2 To taille_contrat societe = Sheets("CONTRAT").Range("T" & j).Value & Sheets("CONTRAT").Range("W" & j).Value annee_debut = Year(Cells(j, 21)) ' test annee date de debut du contrat mois_debut = Month(Cells(j, 21)) ' test mois date de debut du contrat annee_fin = Year(Cells(j, 22)) ' test annee date de fin du contrat mois_fin = Month(Cells(j, 22)) ' test mois date de fin du contrat duree = mois_fin - mois_debut ' on compte combien de mois dure la mission If societe = ste And annee_debut = annee Then Sheets("TABLEAUX").Activate For m = 0 To duree Sheets("TABLEAUX").Cells(i, mois_debut + 2 + m).Value = 1 Next m Sheets("CONTRAT").Activate End If Next j Next i
Seulement voilà, le temps d'execution de cette boucle est extremement long. Elle me donne le résultat voulu sur des données moins conséquente mais avec le temps le volume des données aura plutot tendance a grossir qu'a réduire.
Je souhaiterais donc avoir des conseils pour optimiser cette boucle voir une autre technique pour arriver a mes fins!
Merci a tout ceux qui s pencheront sur mon problème :)

15/05/2012, 15h33
Philippe Tulliez
Bonjour,
Tu peux traiter les données dans un tableau
Ex pour une plage A2;I106
Code:

1 2 Dim maTable() maTable = Range("A2:I106")
Voir Tuto ici et là
15/05/2012, 17h11
olivier41

Merci pour ta réponse corona,

J'avoue ne pas trop me servir des variables tableaux (meme jamais, car elles me paraissent un poil complexes...) mais je vais preter attention a ces deux tutos et essayer de trouver des exemples pour voir si ca peut m'apporter quelque chose!
15/05/2012, 22h18
nchal

Bonjour

Comme à chaque fois qu'il y a une question de performance, je propose de faire un petit Application.ScreenUpdating = False en début de script.
J'ai cru voir dans ton code, des .activate et des cells.value, des commandes qui nécessitent un rafraichissement de l'écran et donc du temps.
Peut-être que dans ton cas, le ScreenUpdating ne va pas convenir mais sa ne coute rien d'essayer.
16/05/2012, 09h11
olivier41

Bonjour nchal, merci pour ta réponse
Je n'ai pas mis l'intégralité de mon code dans mon post mais j'utilise bien un application.screenupdating en début de procédure. etant donné que je travaille sur deux onglets distincts je ne pouvais eviter l'utilisation des .activate!
18/05/2012, 13h12
AlainTech

Citation:

Envoyé par olivier41

etant donné que je travaille sur deux onglets distincts je ne pouvais eviter l'utilisation des .activate!

C'est faux!
Il est parfaitement possible de traiter des onglets et des cellules sans Select ni Activate.

Rebonjour corona, nchal, alainTech

Je reviens vers vous pour vous donnez quelques infos sur mon avancée sur le problème (je suis resté un pti moment sans mettre mon nez dedans)

Tout d'abord alaintech, il est vrai qu'il est déconseillé d'utiliser les select et activate cependant, dans mon script, chaque boucle travaille sur une plage d'un onglet différent :
la boucle A va parcourir l'ongletA
la boucle B va parcourir l'ongletB
donc une fois que la boucle A est terminée, je précise avant de commencer la boucle B sur quel onglet il faut a présent se placer (donc avant la boucle B : ongletB.activate : peut etre existe t-il un autre moyen mais pour le moment je n'ai rien trouvé...)

Cependant dans le meme esprit que le application screenupdating, avant le debut de chaque boucle je met le classeur en mode de calcul manuel puis le repasse en mode de calcul automatique en fin de boucle.

Un autre element important pour accélérer le code est le fait de vider le presse papier (car je fais beaucoup de copier/coller sur de grandes plages de cellules)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 'en debut de procédure on vide le presse papier ppapier.SetText "" ppapier.PutInClipboard 'passage en mode de calcul manuel Application.Calculation = xlManual For j = 2 To 13 a = 0 For i = 3 To taille_candidat test_annee = Year(Cells(i, 45)) test_mois = Month(Cells(i, 45)) auteur = Sheets("CANDIDAT").Range("AT" & i).Value If test_annee = annee And test_mois = Sheets("REPORT GENERAL").Cells(2, j + 7).Value Then a = a + 1 End If Next i Sheets("REPORT GENERAL").Cells(5, j + 7).Value = a Next j Application.Calculation = xlCalculationAutomatic 'deuxème boucle sur un onglet différent (on active la feuille sur laquelle elle doit travailler??) Sheets("FICHE ENTRETIEN").Activate Application.Calculation = xlManual For j = 2 To 13 a = 0 For i = 3 To taille_entretien test_annee = Year(Cells(i, 9)) test_mois = Month(Cells(i, 9)) auteur = Sheets("FICHE ENTRETIEN").Range("H" & i).Value If test_annee = annee And test_mois = Sheets("REPORT GENERAL").Cells(2, j + 7).Value Then a = a + 1 End If Next i Sheets("REPORT GENERAL").Cells(7, j + 7).Value = a Next j Application.Calculation = xlCalculationAutomatic 'on libère l'objet ppapier = nothing
Mon code (qui inclut environ 50 boucles, je sais c'est beaucoup) prenait 10 minutes pour tout executer avant, j'en suis maintenant a 5 minutes. La piste des variables tableaux semble la pus prometteuse pour la suite, je reposte mon code des que j'ai reussi a faire fonctionner une boucle a partir d'un array.

Sous-question : j'ai lu dans certains forums que certains type de boucle sont a privilégier par rapport a d'autres : ainsi l'utilisation des boucles de type for each serait plus rapide que celles de type for i = 1 to n...
quelqu'un pourrait il confirmer.

Encore une fois merci a tous pour l'aide et les conseils que vous fournissez!

Je confirme que le passage par un tableau va résoudre ton problème de performance (Et dire que tu ne veux pas utiliser de tableau, c'est comme dire que tu ne veux pas faire de VBA). Et pour compléter la remarque d'AlainTech, il faut que tu apprennes à déclarer les objets que tu utilises. Par exemple :
Code:

1 2 3 4 Dim wsA As Worksheet Dim wsB As Worksheet Set wsA = Worksheets("OngletA") Set wsB = Worksheets("OngletB")
Ensuite, tu peux utiliser indépendamment wsA et wsB pour accéder aux onglet, plus besoin d'Activate ou de Select.

Essaie de te souvenir que par principe, il ne faut jamais utiliser Range ou Cells tout seul. Il faut toujours préciser sur quel onglet tu travailles et sans pour cela le sélectionner. Sinon imagine que pendant l'exécution d'une macro, ton doigt ripe et tu changes d'onglet par inadvertance, ça peut foutre en l'air tout ton fichier.

Juste pour info, j'ai repris un peu la première boucle de ton code pour te montrer une solution plus rapide (passage par un tableau + identification des feuilles + déclaration des variables). Essaie de t'en inspirer.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 Dim ws As Worksheet Dim wsReport As Worksheet Dim test_annee As Integer Dim test_mois As Integer Dim moisEnCours As Integer Dim i As Integer, j As Integer, a As Integer Dim tmpTab As Variant Set ws = ActiveSheet 'Vu que je ne sais pas le nom de la feuille initiale Set wsReport = Worksheets("REPORT GENERAL") tmpTab = ws.Range(ws.Cells(3, 45), ws.Cells(taille_candidat, 45)) 'passage en mode de calcul manuel Application.Calculation = xlManual For j = 2 To 13 a = 0 moisEnCours = wsReport.Cells(2, j + 7).Value For i = 1 To taille_candidat - 2 test_annee = Year(tmpTab(i, 1)) test_mois = Month(tmpTab(i, 1)) If test_annee = annee And test_mois = moisEnCours Then a = a + 1 Next i wsReport.Cells(5, j + 7).Value = a Next j Application.Calculation = xlCalculationAutomatic

Bonjour Zebreloup,

Merci beaucoup pour l'aide (très précise d'ailleurs) que tu m'as apporté
j'ai adapté ton code au mien. et cela marche parfaitement bien :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
 
Dim ws_candidat As Worksheet, ws_entretien As Worksheet
Dim ws_report As Worksheet
Dim tmptab As Variant
 
 Set ws_candidat = Worksheets("CANDIDAT")
 Set ws_report = Worksheets("REPORT GENERAL")
 Set ws_entretien = Worksheets("FICHE ENTRETIEN")
 
tmptab = ws_candidat.Range(ws_candidat.Cells(3, 45), ws_candidat.Cells(taille_candidat, 45))
Application.Calculation = xlManual
For j = 2 To 13
a = 0
moisencours = ws_report.Cells(2, j + 7).Value
    For i = 1 To taille_candidat - 2
        test_annee = Year(tmptab(i, 1))
        test_mois = Month(tmptab(i, 1))
        auteur = Sheets("CANDIDAT").Range("AT" & i).Value
        If test_annee = annee And test_mois = moisencours Then
        a = a + 1
        End If
    Next i
    ws_report.Cells(4, j + 7).Value = a
Next j
Application.Calculation = xlCalculationAutomatic
 
 
'je redefinis la variable tableau 
tmptab = ws_entretien.Range(ws_entretien.Cells(3, 9), ws_entretien.Cells(taille_entretien, 9))
Application.Calculation = xlManual
For j = 2 To 13
a = 0
moisencours = ws_report.Cells(2, j + 7).Value
    For i = 1 To taille_entretien - 2
        test_annee = Year(tmptab(i, 1))
        test_mois = Month(tmptab(i, 1))
        auteur = Sheets("FICHE ENTRETIEN").Range("H" & i).Value
        If test_annee = annee And test_mois = moisencours Then
        a = a + 1
        End If
    Next i
    ws_report.Cells(7, j + 7).Value = a
Next j
Application.Calculation = xlCalculationAutomatic
 
Set ws_candidat = Nothing
Set ws_report = Nothing

Je dois faire les modif sur l'ensemble de mon code et je pense que ca va me prendre un bon bout de temps!
Une fois terminé je teste pour voir le temps que ca prendra!
En tout cas encore une fois merci :)

12/06/2012, 14h12
ZebreLoup

J'avais fait exprès d'enlever le passage pour auteur, vu qu'il ne servait à rien (si tu réutilises auteur ensuite, tu n'auras que la dernière valeur)

Re Zebreloup ,

En passant par les tableaux, mon code s'execute en environ 20 secondes ce qui est tout bonnement parfait! je tiens a te remercier encore une fois pour ton aide. Le code utilisé ci-dessus est celui utilisé donc pour ceux que ca intérèsse....

P.S : pour la variable auteur je le conserve dans mon code car j'effectue un test sur cette valur dans mon script du genre :
Code:

1 2 3 4 5 6 7 tmptab = ws_candidat.Range(ws_candidat.Cells(3, 44), ws_candidat.Cells(taille_candidat, 45)) test_annee = Year(tmptab(i, 2)) test_mois = Month(tmptab(i, 2)) auteur = tmptab(i,1) If test_annee = annee And test_mois = moisencours and auteur = "x" Then...
Merci a tous les autres également de s'être penché sur mon problème. Je place le post en résolu