lenteur macroRésolu

Question

Bonjour à tous! J'ai établis une macro qui consite à reproduire le même programme sur plusieurs feuilles d'un classeur excel. Au début l'éxécution se faisait en 15 min, aujourd'hui je ne sais pas je n'ais pas eu la patience d'attendre plus d'1/2 heure. au bout de la 3ème feuille la suppression des lignes met un temps fou! je ne sais pas pourquoi!!! HELP! quelqu'un aurait-il une idée???? je vous transmet le code pourtant très simple! (là est peut être le pb d'ailleurs!!) Dim i As Integer 'indice de ligne feuille CR Global Dim i1 As Integer 'indice fixe de ligne Dim j As Integer 'indice de collone des feuilles à remplir Dim k As Integer 'indice de ligne feuille Tab PB et corresp. structure Dim z As Integer 'indice de d'incrémentation des feuilles 'etablissement du TCD "Tab PB et corresp.structure" Sheets("Extrac° Requête ""Report1""").Select Application.Goto Reference:="Extraction" ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:="'Extrac° Requête ""Report1""'!A1:R65536", TableDestination:=Worksheets("Tab PB et corresp. structure").Range("A3"), TableName:="TableauPB", RowGrand:=False, ColumnGrand:=False, SaveData:=False ActiveSheet.PivotTables("TableauPB").AddFields RowFields:=Array("PB", "PBFRANCOS.LIBELLE", "Stru", "LibelleNiv") With ActiveSheet.PivotTables("TableauPB").PivotFields("MntMois2006") .Orientation = xlDataField .Caption = "Mois 2006" .Function = xlSum End With Sheets("Tab PB et corresp. structure").Select ActiveSheet.PivotTables("TableauPB").PivotSelect "Stru[All;Total]", _ xlDataAndLabel, True Selection.Delete ActiveSheet.PivotTables("TableauPB").PivotSelect "PBFRANCOS.LIBELLE[All;Total]" _ , xlDataAndLabel, True Selection.Delete ActiveSheet.PivotTables("TableauPB").PivotSelect "PB[All;Total]", _ xlDataAndLabel, True Selection.Delete Sheets("macro").Select 'Mise en forme des tableaux suivant la structure For z = 12 To 26 Sheets(z).Select If z <> 15 Or z <> 16 Then Select Case z Case 12 i = 6 i1 = 6 j = 1 Case 16 i = 6 i1 = 6 j = 1 Case 14 i = 6 i1 = 6 j = 6 Case 17 i = 6 i1 = 6 j = 6 Case 18 i = 6 i1 = 6 j = 6 Case 19 i = 6 i1 = 6 j = 6 Case 20 i = 6 i1 = 6 j = 6 Case 21 i = 6 i1 = 6 j = 6 Case 22 i = 8 i1 = 8 j = 1 Case 23 i = 8 i1 = 8 j = 1 Case 24 i = 8 i1 = 8 j = 1 Case 25 i = 8 i1 = 8 j = 1 Case 26 i = 8 i1 = 8 j = 1 End Select k = 5 While Sheets(z).Cells(i, j) <> "" If Sheets(z).Cells(i, j) = Worksheets("Tab PB et corresp. structure").Cells(k, 3) Then If Sheets(z).Cells(i, j + 2) <> "" Then i = i + 1 Else Sheets(z).Cells(i, j + 1) = Worksheets("Tab PB et corresp. structure").Cells(k, 1) Sheets(z).Cells(i, j + 2) = Worksheets("Tab PB et corresp. structure").Cells(k, 2) k = k + 1 i = i1 End If Else i = i + 1 End If Wend 'CR Global suppression des lignes vides i = i1 While Sheets(z).Cells(i, j) <> "" If Sheets(z).Cells(i, j + 1) = "" Then Sheets(z).Cells(i, j + 1).EntireRow.Delete --------- c'est apparemment ici que le temps de traitement est long! Else i = i + 1 End If Wend End If Next z Worksheets("macro").Select MsgBox ("Mise à jour de la structure PB terminée!!") End Sub MERCI BEAUCOUP d'avance!!!

galopin01 · Accepted Answer

Bonjour,
J'ai testé ta boucle : il est difficile de travailler dessus on peut à peine la faire travailler 2 fois plus vite (soit 100 lignes à la minute...)
Essaie de remplacer la boucle While par :

'détection de la dernière ligne (colonne j)
x = Cells(65535, j).End(xlUp).Row
For k = x To i Step -1 'de la dernière ligne à la ligne i...
        If Cells(k, j + 1) = "" Then Rows(k).Delete
Next

j'ai fait de nombreuses impasses... mais ça devrait marcher. (on passe à 10 000 lignes / minutes)

Tu pourrais sans doute gagner du temps d'exécution en plaçant un :
Application.ScreenUpdating = False 

(au début de la macro, après les Dim...)

asecher · Answer

Il ne faut pas oublier que VBA est interprété (la notion de compilation ets plutôt une vérification fu code)

On peut optimiser certanes fois en passant par des variables qui récupèrent le contenu d'un objet car l'acces à l'objet peut être pénalisant....

D'autre part, la suppression de "EntireRow" sur une sélection de cellules ne me semble pas très performant, autant détruire les cellules sélectionnées.

Mais bon, Excel & VBA est un couple à problèmes.....

Good Luck,

Alain 31

sosso16 · Answer

Excel et VBA est peut être un couple à pb mais je n'ai pa le choix.... les entreprises étant de grande adeptes d'Excel!

De plus sur un autre fichier (indentique à celui dans lequel le temps d'execution est très long mais un peu plus lourd), le programme s'execute sans soucis....

Je sais pas si tout cela va m'aider mais bon on va essayer! merci qd même!


sosso

sosso16 · Answer

j'ai testé ce code... 

toutefois un message d'erreur apparaît dès la ligne 
x = Cells(270, j).End(xlUp).Row 

x devrait être déclaré en objet range (???) mais cela doit poser un pb dans la boucle for... next

For h = x (objet range) To i (déclaré integer) Step -1 
If Sheets(z).Cells(h, j + 1) = "" Then 
Sheets(z).Rows(h).Select
Selection.Delete
end if

Next h

galopin01 · Answer

bonsoir,
Non, x est le N° de ligne. Donc Integer (ou Long si > 35000 lignes) 
L'erreur provient de Option Explicit si tu l'as mis (ou de 270 si tu as calibré trop court) : 
Cette ligne :
x = Cells(65535, j).End(xlUp).Row  
...sert à détecter le dernier enregistrement à condition qu'il y ait au moins un espace entre ce dernier enregistrement et le nombre que tu mets.
Si tu mets 270 celà suppose que tu es certain qu'il n'y auras jamais plus de 268 enregistrements.


Celà ne sert à rien de diminuer le 65535 (sauf si tu as des données parasites plus bas dans la colonne). C'est l'impasse que j'ai du faire car je ne vois pas ta feuille. 
A+

Lenteur macro

5 réponses

Discussions similaires