Accélération d'une macro
Bonjour tout le monde,
Je suis novice en macro, à force de tuto et de coup de pouce du forum ma plus grosse macro est enfin sur pied. Je pense que pour les experts la macro doit très certainement piquer aux yeux. J'en suis désolé, on est surement tous passé par cette étape :p
Ma macro est particulièrement longue car c'est une série de tâche, j'ai segmenté le code par étape et donc par code succeptible d'être similaire mais au final la vraie macro c'est tous les codes à la suite.
J'ai déjà cherché un peu comme accélérer une macro, il y a le Application.ScreenUpdating qui fait déjà gagné pas mal de temps et qui n'a pas de contrainte pour être appliqué. Pour les autres j'ai peur que les contraintes me fasse sauter ma macro qui est très fragile, bardé de rustine. Actuellement elle mets 47s à s'exécuter !
Je sais qu'il y a des écritures qui peuvent être remplacé/rectifier pour demander moins de temps de travail à la macro mais je ne sais pas trop lequel et surtout qu'elle est la meilleure écriture pour remplacer.
Est ce qu'on âme charitable à :
1/ une astuce globale pour accélérer le tout ( style Application.ScreenUpdating )
2/ m'indiquer quels types de lignes de code est vraiment mal écrite et ralentie l'exécution avec un petit exemple de bonne écriture pour que je puisse le corriger pour le reste de la macro (car il y a pas mal de code similaire au final)
Merci beaucoup à l'ensemble des gens du forum qui m'en permis d'avancer dans la maîtrise (si faible qu'elle soit pour le moment ^^) du macro et qui m'a permis déjà un gain phénoménal du temps !!
Application.ScreenUpdating = False 'accélérer macro début script'
'Copier les données angles et tensions de Sujet RI et RE dans la feuille All mvt'
'Pour bras gauche d'abord RE puis ensuite RI, pour le bras droit faudra changer'
Sheets("Sujet RE").Select
Range("B24:C24").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("All mvt").Select 'copier dans All mvt'
ActiveWindow.SmallScroll Down:=-141
Range("B24").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'supprimer la dernière des 2 colonnes car le début de RE c'est la même valeur que la dernière de RI'
LaDerniere = Range("B500").End(xlUp).Offset(0, 0).Select
Selection.ClearContents
LaDerniere = Range("C500").End(xlUp).Offset(0, 0).Select
Selection.ClearContents
Sheets("Sujet RI").Select
Range("B24:C24").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("All mvt").Select 'copier dans All mvt'
Range("B65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Macro pour créer d'autres colonnes de données pour faire les graphiques pour la RI et la RE'
'permet de créer les colonnes pour moyenner après'
Sheets("Sujet RI").Select 'travail pour RI donc avec recherche de max de C pour le bras gauche'
Dim Xyz As Long
Dim Ijk As Range
Application.ScreenUpdating = False
Xyz = Range("B" & Rows.Count).End(xlUp).Row
Set Ijk = Range("C24:C" & Xyz).Find(what:=Application.min(Range("C24:C" & Xyz)), LookIn:=xlValues, lookat:=xlWhole)
If Not Ijk Is Nothing Then
Range("B24:C" & Ijk.Row + 3).Copy Range("P24")
Range("B" & Ijk.Row - 2 & ":C" & Xyz).Copy Range("S24")
End If
Sheets("Sujet RE").Select 'travail pour RE donc avec recherche de min de C pour le bras gauche'
Dim Lmn As Long
Dim Opq As Range
Application.ScreenUpdating = False
Lmn = Range("B" & Rows.Count).End(xlUp).Row
Set Opq = Range("C24:C" & Lmn).Find(what:=Application.Max(Range("C24:C" & Lmn)), LookIn:=xlValues, lookat:=xlWhole)
If Not Opq Is Nothing Then
Range("B24:C" & Opq.Row + 3).Copy Range("P24")
Range("B" & Opq.Row - 2 & ":C" & Lmn).Copy Range("S24")
End If
'Copie les données qu'il faut pour les 4 graphiques de la feuille All mvt'
Sheets("Sujet RI").Select 'Aller RI'
Range("P25:Q25").Select 'Attention commence à 25 car celle de 24 = la dernière de Retour RE INVERSE pour bras droit !'
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("All mvt").Select
Range("Q24").Select
ActiveSheet.Paste
Sheets("Sujet RI").Select 'Retour RI'
Range("S24:T24").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("All mvt").Select
Range("T24").Select
ActiveSheet.Paste
Sheets("Sujet RE").Select 'Aller RE'
Range("P24:Q24").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("All mvt").Select
Range("W24").Select
ActiveSheet.Paste
Sheets("Sujet RE").Select 'Retour RE'
Range("S24:T24").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("All mvt").Select
Range("AC24").Select
ActiveSheet.Paste
'Rajoute 5 données en fin de colonne Retour RE pour que le moyennage soit bon graphiquement pr All mvt!'
Sheets("All mvt").Select
Range("Q25:R30").Select
Selection.Copy
Range("AC65536").End(xlUp).Offset(1, 0).Select 'se positionner sur la dernière cellule vide de la colonne'
ActiveSheet.Paste
'MFC pour angle neutre et min max tension pour les 3 feuilles'
Sheets("Sujet RI").Select 'travail Sujet RI'
Range("B24").Select 'MFC pour les angles'
Range(Selection, Selection.End(xlDown)).Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=-10", Formula2:="=10"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
End With
Range("C24").Select 'MFC pour les tensions MIN'
Range(Selection, Selection.End(xlDown)).Select
Selection.FormatConditions.AddTop10
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1)
.TopBottom = xlTop10Bottom
.Rank = 1
.Percent = False
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Sheets("Sujet RE").Select 'travail Sujet RE'
Range("B24").Select 'MFC pour les angles'
Range(Selection, Selection.End(xlDown)).Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=-10", Formula2:="=10"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
End With
Range("C24").Select 'MFC pour les tensions MAX'
Range(Selection, Selection.End(xlDown)).Select
Selection.FormatConditions.AddTop10
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1)
.TopBottom = xlTop10Top
.Rank = 1
.Percent = False
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
End With
Sheets("All mvt").Select 'travail All mvt'
Range("B24").Select 'MFC pour les angles'
Range(Selection, Selection.End(xlDown)).Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=-10", Formula2:="=10"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
End With
Range("C24").Select 'MFC pour les tensions MIN'
Range(Selection, Selection.End(xlDown)).Select
Selection.FormatConditions.AddTop10
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1)
.TopBottom = xlTop10Bottom
.Rank = 1
.Percent = False
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("C24").Select 'MFC pour les tensions MAX'
Range(Selection, Selection.End(xlDown)).Select
Selection.FormatConditions.AddTop10
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1)
.TopBottom = xlTop10Top
.Rank = 1
.Percent = False
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
End With
' Recherche tension max-min et l'angle associé pour Sujet RI et Sujet RE '
Sheets("Sujet RI").Select 'on travaille ici RI' ' Ici on va chercher la plus grande valeur d'une colonne
j = 3 'fixer le numéro de colonne voulu
i = 24 'ligne de début de recherche
Value = 99999 'variable qui aura la plus grande valeur (si ça va dans les négatifs, alors la fixer à -99999 par exemple)
Value2 = 0 'la voisine à gauche'
While Not IsEmpty(Cells(i, j))
If Cells(i, j) < Value Then 'changer le signe si on cherche la plus petite
Value = Cells(i, j)
Value2 = Cells(i, j - 1)
End If
i = i + 1
Wend
'on les copie là où on veut (changer N34 et N35 en ce que l'on veut)
Range("N24").Value = Value
Range("M24").Value = Value2
Sheets("Sujet RE").Select 'on travaille ici RE'
j = 3 'fixer le numéro de colonne voulu
i = 24 'ligne de début de recherche
Value = -99999 'variable qui aura la plus grande valeur (si ça va dans les négatifs, alors la fixer à -99999 par exemple)
Value2 = 0 'la voisine à gauche
While Not IsEmpty(Cells(i, j))
If Cells(i, j) > Value Then 'changer le signe si on cherche la plus petite
Value = Cells(i, j)
Value2 = Cells(i, j - 1)
End If
i = i + 1
Wend
'on les copie là où on veut (changer N34 et N35 en ce que l'on veut)
Range("N24").Value = Value
Range("M24").Value = Value2
' Automatisation Copier Coller Hystérésis RI et RE '
Sheets("Sujet RI").Select 'travail pour RI donc avec recherche de max de C pour le bras gauche'
Dim Nblg As Long
Dim Cel As Range
Application.ScreenUpdating = False
Nblg = Range("B" & Rows.Count).End(xlUp).Row
Set Cel = Range("C24:C" & Nblg).Find(what:=Application.min(Range("C24:C" & Nblg)), LookIn:=xlValues, lookat:=xlWhole)
If Not Cel Is Nothing Then
Range("B24:C" & Cel.Row + 0).Copy Destination:=Sheets("Hysteresis RI").Range("A2")
Range("B" & Cel.Row & ":C" & Nblg).Copy Destination:=Sheets("Hysteresis RI").Range("I2")
End If
' Permet de supprimer les mises en forme conditionnelles et de décaler d'une donnée le retour car le max de tension et aussi dans le retour à la base de copier coller'
Sheets("Hysteresis RI").Select
Range("A2:B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.FormatConditions.Delete
Range("I2:J2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.FormatConditions.Delete
Range("I3:J3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("I2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' On peut pas faire de coller spécial avec un couper'
' Du coup last valeur en double alors on supprime la dernière valeur'
LaDerniere = Range("I500").End(xlUp).Offset(0, 0).Select
Selection.ClearContents
LaDerniere = Range("J500").End(xlUp).Offset(0, 0).Select
Selection.ClearContents
' Ajustement de la dernière valeur pour l'hystérésis RI pour avoir une aires exacte '
' Etape 1 supprimer tous les 0 de la colonne dont le numéro est dans le j= et de la ligne i='
Sheets("Hysteresis RI").Select
For i = 3 To 200 'de la ligne à la ligne
For j = 7 To 7 'de la colonne à la colonne'
If Cells(i, j) <= 0 Then
Cells(i, j).ClearContents
End If
Next j
Next i
For i = 3 To 200 'de la ligne à la ligne
For j = 15 To 15 'de la colonne à la colonne'
If Cells(i, j) <= 0 Then
Cells(i, j).ClearContents
End If
Next j
Next i
' Une fois les 0 enlevé on dit de supprimer les dernière valeur'
LaDerniere = Range("G500").End(xlUp).Offset(0, 0).Select
Selection.ClearContents
LaDerniere = Range("O500").End(xlUp).Offset(0, 0).Select
Selection.ClearContents
Sheets("Sujet RE").Select 'travail pour RE donc avec recherche de min de C pour le bras gauche'
Dim Abc As Long
Dim Def As Range
Application.ScreenUpdating = False
Abc = Range("B" & Rows.Count).End(xlUp).Row
Set Def = Range("C24:C" & Abc).Find(what:=Application.Max(Range("C24:C" & Abc)), LookIn:=xlValues, lookat:=xlWhole)
If Not Def Is Nothing Then
Range("B24:C" & Def.Row).Copy Destination:=Sheets("Hysteresis RE").Range("A2")
Range("B" & Def.Row & ":C" & Abc).Copy Destination:=Sheets("Hysteresis RE").Range("I2")
End If
' Permet de supprimer les mises en forme conditionnelles et de décaler d'une donnée le retour car le max de tension et aussi dans le retour à la base de copier coller'
Sheets("Hysteresis RE").Select
Range("A2:B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.FormatConditions.Delete
Range("I2:J2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.FormatConditions.Delete
Range("I3:J3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("I2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' On peut pas faire de coller spécial avec un couper'
' Du coup last valeur en double alors on supprime la dernière valeur'
LaDerniere = Range("I500").End(xlUp).Offset(0, 0).Select
Selection.ClearContents
LaDerniere = Range("J500").End(xlUp).Offset(0, 0).Select
Selection.ClearContents
' Ajustement de la dernière valeur pour l'hystérésis RI pour avoir une aires exacte '
' Etape 1 supprimer tous les 0 de la colonne dont le numéro est dans le j= et de la ligne i='
Sheets("Hysteresis RE").Select
For i = 3 To 200 'de la ligne à la ligne'
For j = 7 To 7 'de la colonne à la colonne'
If Cells(i, j) <= 0 Then
Cells(i, j).ClearContents
End If
Next j
Next i
For i = 3 To 200 'de la ligne à la ligne
For j = 15 To 15 'de la colonne à la colonne'
If Cells(i, j) <= 0 Then
Cells(i, j).ClearContents
End If
Next j
Next i
' Une fois les 0 enlevé on dit de supprimer les dernière valeur'
LaDerniere = Range("G500").End(xlUp).Offset(0, 0).Select
Selection.ClearContents
LaDerniere = Range("O500").End(xlUp).Offset(0, 0).Select
Selection.ClearContents
'Macro pour créer les graphiques RI RE et All mvt'
Sheets("Sujet RI").Select ' ROTATION INTERNE '
ActiveSheet.ChartObjects("Graphique 4").Activate
ActiveWindow.SmallScroll Down:=-150
ActiveSheet.ChartObjects("Graphique 4").Activate
ActiveWindow.SmallScroll Down:=-45
ActiveWindow.SmallScroll ToRight:=5
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).Name = "=""Aller"""
ActiveChart.SeriesCollection(2).XValues = "='Sujet RI'!$Y$27:$Y$172"
ActiveChart.SeriesCollection(2).Values = "='Sujet RI'!$Z$27:$Z$172"
ActiveWindow.SmallScroll ToRight:=-11
ActiveSheet.ChartObjects("Graphique 4").Activate
ActiveChart.SeriesCollection(2).Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(146, 208, 80)
End With
ActiveChart.ChartArea.Select
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(3).Name = "=""Retour"""
ActiveChart.SeriesCollection(3).XValues = "='Sujet RI'!$AD$27:$AD$172"
ActiveChart.SeriesCollection(3).Values = "='Sujet RI'!$AE$27:$AE$172"
ActiveChart.SeriesCollection(3).Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(146, 208, 80)
End With
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
Sheets("Sujet RE").Select ' ROTATION EXTERNE '
ActiveSheet.ChartObjects("Graphique 4").Activate
ActiveWindow.SmallScroll Down:=-150
ActiveSheet.ChartObjects("Graphique 4").Activate
ActiveWindow.SmallScroll Down:=-45
ActiveWindow.SmallScroll ToRight:=5
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).Name = "=""Aller"""
ActiveChart.SeriesCollection(2).XValues = "='Sujet RE'!$Y$27:$Y$172"
ActiveChart.SeriesCollection(2).Values = "='Sujet RE'!$Z$27:$Z$172"
ActiveWindow.SmallScroll ToRight:=-11
ActiveSheet.ChartObjects("Graphique 4").Activate
ActiveChart.SeriesCollection(2).Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(146, 208, 80)
End With
ActiveChart.ChartArea.Select
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(3).Name = "=""Retour"""
ActiveChart.SeriesCollection(3).XValues = "='Sujet RE'!$AD$27:$AD$172"
ActiveChart.SeriesCollection(3).Values = "='Sujet RE'!$AE$27:$AE$172"
ActiveChart.SeriesCollection(3).Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(146, 208, 80)
End With
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
Sheets("All mvt").Select ' ALL MOUVEMENT '
ActiveSheet.ChartObjects("Graphique 4").Activate
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(3).Name = "=""Aller RI"""
ActiveChart.SeriesCollection(3).XValues = "='All mvt'!$AH$27:$AH$300"
ActiveChart.SeriesCollection(3).Values = "='All mvt'!$AI$27:$AI$300"
ActiveSheet.ChartObjects("Graphique 4").Activate
ActiveChart.SeriesCollection(3).Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
End With
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(146, 208, 80)
.Transparency = 0
End With
ActiveChart.ChartArea.Select
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(4).Name = "=""Retour RI"""
ActiveChart.SeriesCollection(4).XValues = "='All mvt'!$AM$27:$AM$300"
ActiveChart.SeriesCollection(4).Values = "='All mvt'!$AN$27:$AN$300"
ActiveChart.SeriesCollection(4).Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(146, 208, 80)
End With
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
ActiveChart.ChartArea.Select
ActiveChart.SeriesCollection(4).Select
ActiveChart.ChartArea.Select
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(5).Name = "=""Aller RE"""
ActiveChart.SeriesCollection(5).XValues = "='All mvt'!$AR$27:$AR$300"
ActiveChart.SeriesCollection(5).Values = "='All mvt'!$AS$27:$AS$300"
ActiveChart.SeriesCollection(5).Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(146, 208, 80)
End With
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(146, 208, 80)
.Transparency = 0
End With
With Selection.Format.Line
.Visible = msoTrue
.DashStyle = msoLineSysDash
End With
ActiveChart.ChartArea.Select
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(6).Name = "=""Retour RE"""
ActiveChart.SeriesCollection(6).XValues = "='All mvt'!$AW$27:$AW$300"
ActiveChart.SeriesCollection(6).Values = "='All mvt'!$AX$27:$AX$300"
ActiveChart.SeriesCollection(6).Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(146, 208, 80)
End With
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
With Selection.Format.Line
.Visible = msoTrue
.DashStyle = msoLineSysDash
End With
' Ajustement des vitesses sujet RI RE et All mvt'
' Supprimer tous les 0 de la colonne D puis supprimer les 2 dernières valeurs de la colonne D'
Sheets("Sujet RI").Select
For i = 3 To 1000 'de la ligne à la ligne
For j = 4 To 4 'de la colonne à la colonne'
If Cells(i, j) <= 0 Then
Cells(i, j).ClearContents 'Font.Bold = True
End If
Next j
Next i
i = 3
While Not IsEmpty(Cells(i, 3)) ' tant qu'il y a des valeurs (i,X)'
If IsEmpty(Cells(i, 4)) Then ' je remets des 0 dans la colonne (i,Y)'
Cells(i, 9).Value = 0
End If
i = i + 1
Wend
' Supprimme les 2 dernière valeurs de la colonne indiqué dans le Range en remontant à partir de la valeur entre () '
LaDerniere = Range("D1000").End(xlUp).Offset(0, 0).Select
Selection.ClearContents
LaDerniere = Range("D1000").End(xlUp).Offset(0, 0).Select
Selection.ClearContents
Sheets("Sujet RE").Select
For i = 3 To 1000 'de la ligne à la ligne
For j = 4 To 4 'de la colonne à la colonne'
If Cells(i, j) <= 0 Then
Cells(i, j).ClearContents
End If
Next j
Next i
i = 3
While Not IsEmpty(Cells(i, 3)) ' tant qu'il y a des valeurs (i,X)'
If IsEmpty(Cells(i, 4)) Then ' je remets des 0 dans la colonne (i,Y)'
Cells(i, 9).Value = 0
End If
i = i + 1
Wend
' Supprimme les 2 dernière valeurs de la colonne indiqué dans le Range en remontant à partir de la valeur entre () '
LaDerniere = Range("D1000").End(xlUp).Offset(0, 0).Select
Selection.ClearContents
LaDerniere = Range("D1000").End(xlUp).Offset(0, 0).Select
Selection.ClearContents
Sheets("All mvt").Select
For i = 3 To 1000 'de la ligne à la ligne
For j = 4 To 4 'de la colonne à la colonne'
If Cells(i, j) <= 0 Then
Cells(i, j).ClearContents
End If
Next j
Next i
i = 3
While Not IsEmpty(Cells(i, 3)) ' tant qu'il y a des valeurs (i,X)'
If IsEmpty(Cells(i, 4)) Then ' je remets des 0 dans la colonne (i,Y)'
Cells(i, 9).Value = 0
End If
i = i + 1
Wend
' Supprimme les 2 dernière valeurs de la colonne indiqué dans le Range en remontant à partir de la valeur entre () '
LaDerniere = Range("D1000").End(xlUp).Offset(0, 0).Select
Selection.ClearContents
LaDerniere = Range("D1000").End(xlUp).Offset(0, 0).Select
Selection.ClearContents
Sheets("Sujet RI").Select
Application.ScreenUpdating = True 'fin pour accélérer la macro c'est facultatif c'est une histoire d'affiche
Juste à première vue (si je vois bien):
dans ce loop, tu n'as pas de sortie:
Value = 99999
'...
If Cells(i, j) < Value Then 'changer le signe si on cherche la plus petite
Value = Cells(i, j)
Value2 = Cells(i, j - 1)
End If
Donc soit: a) limite la valeur de "Value" ou b) ajoute une sortie dans ton If...
Bonjour
Tu écris :
une astuce globale pour accélérer le tout ( style Application.ScreenUpdating )
Cette instuction fait effectivement gagner du temps mais il vaut mieux la mettre en début de macro.
m'indiquer quels types de lignes de code est vraiment mal écrite et ralentie l'exécution
Mal écrites non mais qui pourrait te faire gagner du temps en les écrivant autrement.
Je vois en effet beaucoup de ‘’.select’’ qui sont à éviter si on veut accéler.
Exemple. Tu as :
Sheets("Sujet RE").Select
Range("B24:C24").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Tu peux l’écrire ainsi
Sheets("Sujet RE").Range("B24:C24"). Range(Selection, Selection.End(xlDown.Copy
Et comme ce genre d’instructions revient souvent dans ton code, en condensant, tu devrais améliorer les choses.
Bon courage !
Bye !
Et encore:
1) vire aussi toutes les lignes avec les "scrolls"...
exemple:
ActiveWindow.SmallScroll Down:=-45
ActiveWindow.SmallScroll ToRight:=5
Elles ne servent strictement à rien... A part à ralentir le code.
2) il y a des instructions qui se répétent. Tu peux nettoyer tout cela aussi:
exemple (deux fois la même instruction):
' Supprimme les 2 dernière valeurs de la colonne indiqué dans le Range en remontant à partir de la valeur entre () '
LaDerniere = Range("D1000").End(xlUp).Offset(0, 0).Select
Selection.ClearContents
LaDerniere = Range("D1000").End(xlUp).Offset(0, 0).Select
Selection.ClearContents
Edit: ah, j'ai compris pourquoi tu utilises cela. Utilise alors plutôt ceci (ce n'est pas très "propre" mais cela fera l'affaire!):
Range("D1000").End(xlUp).ClearContents
Range("D1000").End(xlUp).ClearContents
Au moins tu ne dois pas a) chipoter avec les sélections (voir la réponse de gmb) et b) tu n'updates pas le contenu de la variable
Bonjour,
Je ne vois pas comment on peut y arriver sans avoir le fichier sous les yeux.
A+
Excel-Malin a écrit :Juste à première vue (si je vois bien):
dans ce loop, tu n'as pas de sortie:
Value = 99999 '... If Cells(i, j) < Value Then 'changer le signe si on cherche la plus petite Value = Cells(i, j) Value2 = Cells(i, j - 1) End If
Donc soit: a) limite la valeur de "Value" ou b) ajoute une sortie dans ton If...
Merci je vais prendre l'option a)
Excel-Malin a écrit :Et encore:
1) vire aussi toutes les lignes avec les "scrolls"...
exemple:
ActiveWindow.SmallScroll Down:=-45 ActiveWindow.SmallScroll ToRight:=5
Elles ne servent strictement à rien... A part à ralentir le code.
2) il y a des instructions qui se répétent. Tu peux nettoyer tout cela aussi:
exemple (deux fois la même instruction):
' Supprimme les 2 dernière valeurs de la colonne indiqué dans le Range en remontant à partir de la valeur entre () ' LaDerniere = Range("D1000").End(xlUp).Offset(0, 0).Select Selection.ClearContents LaDerniere = Range("D1000").End(xlUp).Offset(0, 0).Select Selection.ClearContents
Edit: ah, j'ai compris pourquoi tu utilises cela. Utilise alors plutôt ceci (ce n'est pas très "propre" mais cela fera l'affaire!):
Range("D1000").End(xlUp).ClearContents Range("D1000").End(xlUp).ClearContents
Au moins tu ne dois pas a) chipoter avec les sélections (voir la réponse de gmb) et b) tu n'updates pas le contenu de la variable
1) Yes je me disais bien que ça servait pas à grand chose des SmallScroll je vais pouvoir les supprimer sans complexes
2) Je dois supprimer les 2 dernières cases de la colonne D du coup j'ai mis 2 fois la même consigne ^^
gmb a écrit :Bonjour
Tu écris :
une astuce globale pour accélérer le tout ( style Application.ScreenUpdating )
Cette instuction fait effectivement gagner du temps mais il vaut mieux la mettre en début de macro.
m'indiquer quels types de lignes de code est vraiment mal écrite et ralentie l'exécution
Mal écrites non mais qui pourrait te faire gagner du temps en les écrivant autrement.
Je vois en effet beaucoup de ‘’.select’’ qui sont à éviter si on veut accéler.
Exemple. Tu as :
Sheets("Sujet RE").Select Range("B24:C24").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy
Tu peux l’écrire ainsi
Sheets("Sujet RE").Range("B24:C24"). Range(Selection, Selection.End(xlDown.Copy
Et comme ce genre d’instructions revient souvent dans ton code, en condensant, tu devrais améliorer les choses.
Bon courage !
Bye !
1/ yes je l'ai mis au début et à la fin de la macro le code avec Application.ScreenUpdating
2/ J'ai une erreur de parenthèse avec la Sheets("Sujet RE").Range("B24:C24"). Range(Selection, Selection.End(xlDown.Copy et je ne sais pas trop où la caser la parenthèse :/
Je suppose aussi que le code suivant peut être groupé ?
Sheets("All mvt").Select
Range("W24").Select
ActiveSheet.Paste
galopin01 a écrit :Bonjour,
Je ne vois pas comment on peut y arriver sans avoir le fichier sous les yeux.
A+
Honnêtement ça serait très très compliqué à expliqué avec le fichier en plus. Je savais qu'il y avait des codes qu'on peut réécrire plus proprement pour gagner du temps et que cela ne demandaient pas d'avoir le fichier sous les yeux (vous vous serez tiré les cheveux avec le fichier ce que je ne souhaite pas ^^)
1) il en manque deux. Comme ça:
Sheets("Sujet RE").Range("B24:C24"). Range(Selection, Selection.End(xlDown)).Copy
2) oui:
Sheets("All mvt").Range("W24").Select
ActiveSheet.Paste
Etrange car en remplaçant
Sheets("Sujet RE").Select
Range("B24:C24").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Par :
Sheets("Sujet RE").Range("B24:C24"). Range(Selection, Selection.End(xlDown)).Copy
Dans le début de la macro à savoir :
Sheets("Sujet RE").Select
Range("B24:C24").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("All mvt").Select 'copier dans All mvt'
ActiveWindow.SmallScroll Down:=-141
Range("B24").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Je me tape l'erreur d'exécution 1004
heislsim a écrit :Etrange car en remplaçant
Sheets("Sujet RE").Select
Range("B24:C24").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Par :
Sheets("Sujet RE").Range("B24:C24"). Range(Selection, Selection.End(xlDown)).Copy
Dans le début de la macro à savoir :
Sheets("Sujet RE").Select
Range("B24:C24").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("All mvt").Select 'copier dans All mvt'
ActiveWindow.SmallScroll Down:=-141
Range("B24").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Je me tape l'erreur d'exécution 1004
C'est correct comme ceci:
Range(Range("B24:C24"), Range("B24:C24").End(xlDown)).Copy
Le tout:
Sheets("Sujet RE").Select
Range(Range("B24:C24"), Range("B24:C24").End(xlDown)).Copy
Sheets("All mvt").Select
Range("B24").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Bonsoir,
Honnêtement ça serait très très compliqué à expliqué avec le fichier en plus. Je savais qu'il y avait des codes qu'on peut réécrire plus proprement pour gagner du temps et que cela ne demandaient pas d'avoir le fichier sous les yeux (vous vous serez tiré les cheveux avec le fichier ce que je ne souhaite pas ^^)
Je ne demande pas d'autres explications... Juste le fichier !
Une macro est une pièce d'horlogerie : On ne fait pas un programme avec des bouts de code à la queue-leu-leu.
Il faut déboguer... et déboguer sans fichier ?
De plus la stricte réduction des Select ou des SmallScroll risque de ne pas apporter grand chose.
Alors qu'il existe des méthodes d'optimisation autrement efficace...
A+
Shit, je n'arrive pas à adapter la partie collage pour des séquences comme ceci
Séquence de base
Sheets("Sujet RI").Select 'Retour RI'
Range("S24:T24").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("All mvt").Select
Range("T24").Select
ActiveSheet.Paste
La version provisoire :
Sheets("Sujet RI").Select 'Retour RI'
Range(Range("S24:T24"), Range("S24:T24").End(xlDown)).Copy
Sheets("All mvt").Select
Range("T24").Select
ActiveSheet.Paste
je pensais que je pouvais supprimer Select ActiveSheet pour mettre bout à bout les 2 lignes comme l'exemple au dessus avec le collage spécial mais non :/
@ galopin01
Merci, j'avoue que l'idéal serait ça mais honnêtement, je n'ai pas l'âme à vous déranger à ce point là car c'est vraiment lourd comme boulot. Je souhaite me parfaire un peu plus en apprenant déjà un peu plus les bonnes manières d'écrire mais tout recommencer depuis le début non car je l'utilise déjà actuellement (c'est un fichier de base de traitement de donnée pour mon mémoire et j'ai une 100ène d'heure de traitement à faire avec et bien sur à faire le plus rapidement possible alors là c'est des secondes bonus de gagné + un peu plus d'apprentissage que je cherche là ^^ )