raccourcir le délai d'esécution

Bonjour,

Les grands classiques du gain de temps sont:

en début de macro:

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

et en fin de macro

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

Cela permet de bloquer temporairement le calcul et la mise a jour de
l'ecran.

Sinon il faut employer une autre logique qu'une boucle.

Par exemple:

If Cells(ligne, 5) = "" Then Rows(ligne).Delete

peut etre remplacé par:

Cells.Columns(5).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

A supposer que ta plage de donnee soit nomme "MesDonnees", l'utilisation du
filtre automatique peut aussi rendre service:

Dim MesCriteres(), i As Integer
MesCriteres = Array("Bateau", "Avion", "Voiture", "Train", "Velo",
"Metro", "Piéton", "Somme")
With Range("MesDonnees")
.Rows(1).EntireRow.Hidden = True 'Masque la ligne de titre
For i = 0 To UBound(MesCriteres)
.AutoFilter Field:=1, Criteria1:=MesCriteres(i) 'Filtre la
plage
.SpecialCells(xlCellTypeVisible).EntireRow.Delete 'Supprime
les lignes
Next
.Rows(1).EntireRow.Hidden = False 'Affiche la ligne de titre
.AutoFilter 'Supprime le filtre
End With

Pour résumer:

Sub SuppressionRapide()
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Cells.Columns(5).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Dim MesCriteres(), i As Integer
MesCriteres = Array("Bateau", "Avion", "Voiture", "Train", "Velo",
"Metro", "Piéton", "Somme")

With Range("A1").CurrentRegion
.Rows(1).EntireRow.Hidden = True 'Masque la ligne de titre
For i = 0 To UBound(MesCriteres)
.AutoFilter Field:=1, Criteria1:=MesCriteres(i) 'Filtre la
plage
.SpecialCells(xlCellTypeVisible).EntireRow.Delete 'Supprime
les lignes
Next
.Rows(1).EntireRow.Hidden = False 'Affiche la ligne de titre
.AutoFilter 'Supprime le filtre
End With

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

Je te laisse tester avant de et me dire ce que tu en pense avant de me
pencher sur le reste.

Cordialement,

Manu
"liloo23" <linkins2h@hotmail.com> a écrit dans le message de news:
8AD8E396-1D99-495B-AEA7-2220FBF27CEA@microsoft.com...

Bonjour à tous,

j'ai réalisé une macro (ci-dessous) mais celle-ci met énormément de temps
à
s'exécuter, je ne sais pas si quequ'un saurait éventuellement comment
remédier à ce problème.

Merci par avance.

Cordialement.

Liloo


Sub Macro

Dim ligne As Double

ActiveWindow.WindowState = xlMinimized

For ligne = Range("A65536").End(xlUp).Row To 1 Step -1

If Cells(ligne, 5) = "" Then Rows(ligne).Delete

If Cells(ligne, 1) = "" Or Cells(ligne, 1) = "Bateau" Or
Cells(ligne, 1) = "Avion" Or Cells(ligne, 1) = "Voiture" Or Cells(ligne,
1) > "Train" Or Cells(ligne, 1) = "Vélo" Or Cells(ligne, 1) = "Métro" Or
Cells(ligne, 1) = "Piéton" Or Cells(ligne, 1) = "Somme" Then
Rows(ligne).Delete

If Cells(ligne, 8) <> "AA" And Cells(ligne, 8) <> "BB" And
Cells(ligne, 8) <> "CC" Then Cells(ligne, 8).FormulaR1C1 = "DD"

If Left(Cells(ligne, 3), 1) = "Nom" And Left(Cells(ligne, 7),
1)
<> "Prénom" Then Rows(ligne).Delete

Next ligne

Range("G2:G4000").Select
Selection.TextToColumns Destination:=Range("G2"),
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(10, 1)),
TrailingMinusNumbers:=True
ActiveWindow.SmallScroll Down:

For ligne = Range("A65536").End(xlUp).Row To 1 Step -1

Cells(ligne, 16).FormulaR1C1 = "=RC[-7]"

If Left(Cells(ligne, 3), 1) = "Lieu" Then Cells(ligne,
16).FormulaR1C1 = "=-ABS(RC[-7])"

If Left(Cells(ligne, 7), 1) = "heure" Or Left(Cells(ligne, 7),
1) = "minute" Or Left(Cells(ligne, 7), 1) = "seconde" Then Cells(ligne,
13).FormulaR1C1 = "=RIGHT(RC[-6],5)"

If Left(Cells(ligne, 7), 1) = "heure" Or Left(Cells(ligne, 7),
1) = "minute" Then Cells(ligne, 14).FormulaR1C1 > "=INDEX(jour!R2C2:R65536C3,MATCH(RC[-1],jour!R2C2:R65536C2,),2)"

If Left(Cells(ligne, 7), 1) = "heure" Or Left(Cells(ligne, 7),
1) = "minute" Then Cells(ligne, 15).FormulaR1C1 > "=INDEX(jour!R2C4:R65536C5,MATCH(RC[-2],jour!R2C4:R65536C4,),2)"

If Left(Cells(ligne, 7), 1) <> "heure" And Left(Cells(ligne,
7),
1) <> "minute" Then Cells(ligne, 14).FormulaR1C1 > "=INDEX(jour!R2C2:R65536C3,MATCH(RC[-7],jour!R2C2:R65536C2,),2)"

If Left(Cells(ligne, 7), 1) <> "heure" And Left(Cells(ligne,
7),
1) <> "minute" Then Cells(ligne, 15).FormulaR1C1 > "=INDEX(jour!R2C4:R65536C5,MATCH(RC[-8],jour!R2C4:R65536C4,),2)"

Next ligne

ActiveWindow.WindowState = xlMaximized

End Sub

Bonjour,

en effet, la macro se déroule beaucoup plus rapidement ...

S'il te plaît, à quoi correspond la fonction "i as integer" ?
Faut-il appliquer le même principe pour la suite de ma macro qui comprend
notamment des fonctions "left", "index", "match"et "formula" ?

Merci énormément.

Cordialement.

Bonjour,

Dim i as integer n'est qu'une déclaration de variable de type nombre entier.

Pour en revenir à ta question initiale le principe est d'effectuer des
opérations sur des blocs de cellules plutot que de passer toutes les
cellules en revue une par une.
Ci dessous une version un peu plus complète de ta macro révisée.

Sub SuppressionRapide()
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

'Ta 1ere boucle For .. Next est remplacée par:
Cells.Columns(5).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Dim MesCriteres(), i As Integer
MesCriteres = Array("Bateau", "Avion", "Voiture", "Train", "Velo",
"Metro", "Piéton", "Somme")

With Range("A1").CurrentRegion
.Rows(1).EntireRow.Hidden = True 'Masque la ligne de titre
For i = 0 To UBound(MesCriteres)
.AutoFilter Field:=1, Criteria1:=MesCriteres(i) 'Filtre la
plage
.SpecialCells(xlCellTypeVisible).EntireRow.Delete 'Supprime
les lignes
Next

'!!!!!!!!!
'If Left(Cells(ligne, 3), 1) = "Nom" And Left(Cells(ligne, 7), 1) <>
"Prénom" Then Rows(ligne).Delete
'Je ne comprend pas cette ligne, Left renverra toujours 1 caractere
'le resultat ne sera jamais egal a "Nom" et sera toujours different de
"Prenom"
'Par consequent aucune ligne ne pourra jamais etre effacé
'!!!!!!!!!

.Rows(1).EntireRow.Hidden = False 'Affiche la ligne de titre
MesCriteres = Array("AA", "BB", "CC")
For i = 0 To UBound(MesCriteres)
.AutoFilter Field:=8, Criteria1:=MesCriteres(i) 'Filtre la
plage
.Columns(.Columns.Count +
1).SpecialCells(xlCellTypeVisible).Value = 1 'Marque les lignes a ne pas
modifier
Next
.AutoFilter 'Supprime le filtre
End With
With Range("A1").CurrentRegion
.Columns(.Columns.Count).SpecialCells(xlCellTypeBlanks).Offset(0, -(.Columns.Count
- 8)).Value = "DD"
.Columns(.Columns.Count).Clear 'Supprime colonne temporaire
End With

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

Concernant la 2eme boucle outre que tu pourrais réduire le nombre de test en
écrivant:

If Left(Cells(ligne, 7), 1) = "heure" Or Left(Cells(ligne, 7), 1) =
"minute" Then
Cells(ligne, 14).FormulaR1C1 =
"=INDEX(jour!R2C2:R65536C3,MATCH(RC[-1],jour!R2C2:R65536C2,),2)"
Cells(ligne, 15).FormulaR1C1 =
"=INDEX(jour!R2C4:R65536C5,MATCH(RC[-2],jour!R2C4:R65536C4,),2)"
Else
Cells(ligne, 14).FormulaR1C1 =
"=INDEX(jour!R2C2:R65536C3,MATCH(RC[-7],jour!R2C2:R65536C2,),2)"
Cells(ligne, 15).FormulaR1C1 =
"=INDEX(jour!R2C4:R65536C5,MATCH(RC[-8],jour!R2C4:R65536C4,),2)"
End If

Néanmoins j'attire ton attention sur le fait que quelque soit le contenu de
tes cellules c'est sytématiquement la deuxieme partie de l'alternative qui
sera exécutée (Cf ma remarque plus haut). Le test en lui même est donc à
revoir.

Cordialement,

Manu/

"liloo23" <linkins2h@hotmail.com> a écrit dans le message de news:
D3F144B2-378E-4B09-A751-BDC17E285D7E@microsoft.com...

Bonjour,

en effet, la macro se déroule beaucoup plus rapidement ...

S'il te plaît, à quoi correspond la fonction "i as integer" ?
Faut-il appliquer le même principe pour la suite de ma macro qui comprend
notamment des fonctions "left", "index", "match"et "formula" ?

Merci énormément.

Cordialement.

Bonjour,

j'ai essayé de mettre en application uniquement cette partie de la macro,
mais elle ne veut pas s'exécuter. Il semblerait qu'il y ait un problème à
partir de la 6ème ligne.

Merci beaucoup pour votre aide.

Cordialement.

Sub SupressionRapide ()
Dim MesCriteres(), i As Integer
MesCriteres = Array("AI", "AT", "Cpt Ana")
With Range("A1").CurrentRegion
For i = 0 To UBound(MesCriteres)
.AutoFilter Field:=8, Criteria1:=MesCriteres(i)
.Columns(.Columns.Count + 1).SpecialCells(xlCellTypeVisible).Value = 1
'Marque les lignes a ne pas modifier
Next
.AutoFilter 'Supprime le filtre
End With
With Range("A1").CurrentRegion
.Columns(.Columns.Count).SpecialCells(xlCellTypeBlanks).Offset(0,
-(.Columns.Count - 8)).Value = "CO"
.Columns(.Columns.Count).Clear 'Supprime colonne temporaire
End With
End Sub

Bonjour,

Je viens de tester ce code sur une liste de 10000 lignes, son résultat est
de remplacer dans la 8eme colonne toutes les valeurs qui ne sont pas dans
MesCriteres par la valeur "CO".

Est ce bien ce que tu voulais?

Peux tu préciser quel genre de probleme tu rencontre(plantage complet
d'Excel, erreur de compilation ou erreur d'éxecution, et avec quel message).

Dans l'attente,

Manu/

"liloo23" <linkins2h@hotmail.com> a écrit dans le message de news:
72DF484F-A038-4D01-8302-874FB16985AA@microsoft.com...

Bonjour,

j'ai essayé de mettre en application uniquement cette partie de la macro,
mais elle ne veut pas s'exécuter. Il semblerait qu'il y ait un problème à
partir de la 6ème ligne.

Merci beaucoup pour votre aide.

Cordialement.

Sub SupressionRapide ()
Dim MesCriteres(), i As Integer
MesCriteres = Array("AI", "AT", "Cpt Ana")
With Range("A1").CurrentRegion
For i = 0 To UBound(MesCriteres)
.AutoFilter Field:=8, Criteria1:=MesCriteres(i)
.Columns(.Columns.Count + 1).SpecialCells(xlCellTypeVisible).Value = 1
'Marque les lignes a ne pas modifier
Next
.AutoFilter 'Supprime le filtre
End With
With Range("A1").CurrentRegion
.Columns(.Columns.Count).SpecialCells(xlCellTypeBlanks).Offset(0,
-(.Columns.Count - 8)).Value = "CO"
.Columns(.Columns.Count).Clear 'Supprime colonne temporaire
End With
End Sub