Optimisation de VBA

Le 03/06/2015 à 15:00

Bonjour,

Voici une VBA qui fonctionne très bien (en tout cas elle fait ce que je veux qu'elle fasse), cependant je vais être amené à gérer des fichiers Excel avec beaucoup de données, et je voulais savoir s'il était possible d'optimiser cette VBA afin qu'elle tourne plus vite.

En vous remerciant par avance.

Sub Macro3()
'
' Macro3 Macro
'

'
Dim MS As Worksheet, sh As Worksheet
Dim DernLigne As Long
Dim DernLigne2 As Long
Dim DernLigne3 As Long
Dim DernLigne4 As Long
Dim l As Long
Dim DerniereLigne As Long
Dim MaCell As Range
Dim Etape As Range
Dim carac As Range
Dim Ensemble_module As Range
Dim fatigue As Range
Dim Etapetrouve As String, PlageDeRecherche As Range
Dim Valeur_Cherchee As String
Dim i As Long
Dim j As Long
Dim h As Long
Dim m As Long
Dim p As Long
Dim ae As Long
Dim az As Long
Dim mo As Long
Dim du As Long
Dim ra As Long
Dim rcel As Range
Dim nomb As Integer
Dim nombreoxy As Integer
Dim nombrecar As Integer
Dim nombrecycle As Integer
Dim nombremodule As Integer
Dim nombreetape As Integer
Dim totaldecalage As Integer
Dim dec As Integer

Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Ensemble_module"
Range("A1").Select
ActiveCell.FormulaR1C1 = "Tps (hr)"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Module secant GPa"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Def résiduelle"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Def a ctr max"

Range("A2").Select
ActiveCell.FormulaR1C1 = "7"
Range("A3").Select
ActiveCell.FormulaR1C1 = "14"
Range("A4").Select
ActiveCell.FormulaR1C1 = "21"
Range("A3:A4").Select
Selection.AutoFill Destination:=Range("A3:A51"), Type:=xlFillDefault
Range("A3:A51").Select
ActiveWindow.SmallScroll Down:=-18

Sheets("Essai1.steps.Tracking").Select

Cells.Replace What:=".", Replacement:=".", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

    Columns("B:C").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "tps (min)"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]/60"
    Range("B2").Select
    Selection.AutoFill Destination:=Range("B2:B60936")
    Range("B2:B60936").Select
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "ctr (Mpa)"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]/69.822"
    Range("G2").Select
    Selection.AutoFill Destination:=Range("G2:G60936")
    Range("G2:G60936").Select
    ActiveWindow.SmallScroll Down:=-9
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "Def (%)"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "=(RC[-1]-R2C9)"
    Range("J2").Select
    Selection.AutoFill Destination:=Range("J2:J60936")
    Range("J2:J60936").Select
    Range("L2").Select

Sheets("Essai1.steps.Tracking").Select
Range(Range("A1").Offset(0, 0), Range("J1").Offset(0, 0)).Select
    Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Caractérisation initiale"
Range("A1").Select
ActiveSheet.Paste

Sheets("Essai1.steps.Tracking").Select

With ThisWorkbook.Sheets("Essai1.steps.tracking")

For j = 1 To 5

nombre = 0

For i = 2 To .Range("D" & .Rows.Count).End(xlUp).Row

                        If .Range("D" & i).Value = j Then
                                   nomb = nomb + 1

                        End If

Next i
Next j

Range(Range("A1").Offset(1, 0), Range("J1").Offset(nomb, 0)).Select
    Selection.Cut
    Sheets("Caractérisation initiale").Select
    Range("A2").Select
    ActiveSheet.Paste

    DernLigne2 = Range("B" & Rows.Count).End(xlUp).Row

Range("L5").Select

    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).Name = "=""" & ActiveSheet.Name & """"
    ActiveChart.SeriesCollection(1).XValues = "='" & ActiveSheet.Name & "'!$J$2:$J$" & DernLigne2
    ActiveChart.SeriesCollection(1).Values = "='" & ActiveSheet.Name & "'!$G$2:$G$" & DernLigne2

Range("M5").Select

    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).Name = "=""" & ActiveSheet.Name & """"
    ActiveChart.SeriesCollection(1).XValues = "='" & ActiveSheet.Name & "'!$B$2:$B$" & DernLigne2
    ActiveChart.SeriesCollection(1).Values = "='" & ActiveSheet.Name & "'!$G$2:$G$" & DernLigne2

Range("R5").Select

    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).Name = "=""" & ActiveSheet.Name & """"
    ActiveChart.SeriesCollection(1).XValues = "='" & ActiveSheet.Name & "'!$B$2:$B$" & DernLigne2
    ActiveChart.SeriesCollection(1).Values = "='" & ActiveSheet.Name & "'!$H$2:$H$" & DernLigne2

Sheets("Essai1.steps.Tracking").Select

Range(Range("A1").Offset(1, 0), Range("J1").Offset(nomb, 0)).Select
    Selection.EntireRow.Delete

End With

Sheets("Essai1.steps.Tracking").Select
Range(Range("A1").Offset(0, 0), Range("J1").Offset(0, 0)).Select
    Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Oxydation"
Range("A1").Select
ActiveSheet.Paste

Sheets("Essai1.steps.Tracking").Select

With ThisWorkbook.Sheets("Essai1.steps.tracking")

For m = 6 To 10

nombre = 0

For p = 2 To .Range("D" & .Rows.Count).End(xlUp).Row

                        If .Range("D" & p).Value = m Then
                                   nombreoxy = nombreoxy + 1

                        End If

Next p
Next m

Range(Range("A1").Offset(1, 0), Range("J1").Offset(nombreoxy, 0)).Select
    Selection.Cut
    Sheets("Oxydation").Select
    Range("A2").Select
    ActiveSheet.Paste

    DernLigne3 = Range("B" & Rows.Count).End(xlUp).Row

Range("L5").Select

    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).Name = "=""" & ActiveSheet.Name & """"
    ActiveChart.SeriesCollection(1).XValues = "='" & ActiveSheet.Name & "'!$J$2:$J$" & DernLigne3
    ActiveChart.SeriesCollection(1).Values = "='" & ActiveSheet.Name & "'!$G$2:$G$" & DernLigne3

Range("M5").Select

    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).Name = "=""" & ActiveSheet.Name & """"
    ActiveChart.SeriesCollection(1).XValues = "='" & ActiveSheet.Name & "'!$B$2:$B$" & DernLigne3
    ActiveChart.SeriesCollection(1).Values = "='" & ActiveSheet.Name & "'!$G$2:$G$" & DernLigne3

Range("R5").Select

    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).Name = "=""" & ActiveSheet.Name & """"
    ActiveChart.SeriesCollection(1).XValues = "='" & ActiveSheet.Name & "'!$B$2:$B$" & DernLigne3
    ActiveChart.SeriesCollection(1).Values = "='" & ActiveSheet.Name & "'!$H$2:$H$" & DernLigne3

Sheets("Essai1.steps.Tracking").Select

Range(Range("A1").Offset(1, 0), Range("J1").Offset(nombreoxy, 0)).Select
    Selection.EntireRow.Delete

End With

For h = 1 To 10

Sheets("Essai1.steps.Tracking").Select
Range(Range("A1").Offset(0, 0), Range("J1").Offset(0, 0)).Select
    Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "fatigue" & h
Range("A1").Select
ActiveSheet.Paste

Sheets("Essai1.steps.Tracking").Select
Range(Range("A1").Offset(0, 0), Range("J1").Offset(0, 0)).Select
    Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "carac" & h
Range("A1").Select
ActiveSheet.Paste

Sheets("Essai1.steps.Tracking").Select

With ThisWorkbook.Sheets("Essai1.steps.tracking")

nombre = 0
nombrecycle = 0

For ae = 2 To .Range("D" & .Rows.Count).End(xlUp).Row

                        If .Range("D" & ae).Value = 11 And .Range("E" & ae).Value = h Then
                                   nombrecycle = nombrecycle + 1

                        End If

Next ae

Range(Range("A1").Offset(1, 0), Range("J1").Offset(nombrecycle, 0)).Select
    Selection.Cut
    Sheets("fatigue" & h).Select
    Range("A2").Select
    ActiveSheet.Paste

Sheets("Essai1.steps.Tracking").Select

Range(Range("A1").Offset(1, 0), Range("J1").Offset(nombrecycle, 0)).Select
    Selection.EntireRow.Delete

Sheets("Essai1.steps.Tracking").Select

nombre = 0
nombrecar = 0

For az = 12 To 15

For ae = 2 To .Range("D" & .Rows.Count).End(xlUp).Row

            If .Range("D" & ae).Value = az And .Range("E" & ae).Value = h Then
                                   nombrecar = nombrecar + 1

                        End If

Next ae
Next az

Range(Range("A1").Offset(1, 0), Range("J1").Offset(nombrecar, 0)).Select
    Selection.Cut
    Sheets("carac" & h).Select
    Range("A2").Select
    ActiveSheet.Paste

Sheets("carac" & h).Select

nombre = 0
nombremodule = 0

For mo = 13 To 14
For du = 2 To Range("D" & Rows.Count).End(xlUp).Row

            If Range("D" & du).Value = mo Then
                                   nombremodule = nombremodule + 1

                        End If

Next du
Next mo

nombre = 0
nombreetape = 0

For ra = 2 To Range("D" & Rows.Count).End(xlUp).Row

            If Range("D" & ra).Value = 12 Then
                                   nombreetape = nombreetape + 1

                        End If

Next ra

Range(Range("A1").Offset(0, 0), Range("J1").Offset(0, 0)).Select
    Selection.Copy
    Range("P1").Select
    ActiveSheet.Paste

totaldecalage = nombreetape + nombremodule

Range(Range("A1").Offset(nombreetape, 0), Range("J1").Offset(totaldecalage, 0)).Select
    Selection.Cut
    Range("P2").Select
    ActiveSheet.Paste

    DernLigne3 = Range("B" & Rows.Count).End(xlUp).Row
    DernLigne4 = Range("V" & Rows.Count).End(xlUp).Row

Range("L5").Select

    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).Name = "=""" & ActiveSheet.Name & """"
    ActiveChart.SeriesCollection(1).XValues = "='" & ActiveSheet.Name & "'!$Y$2:$Y$" & DernLigne4
    ActiveChart.SeriesCollection(1).Values = "='" & ActiveSheet.Name & "'!$V$2:$V$" & DernLigne4

nombre = 0
tracmo = 0

For wx = 2 To Range("S" & Rows.Count).End(xlUp).Row

            If Range("S" & wx).Value = 13 Then
                                   tracmo = tracmo + 1

                        End If

Next wx

    Range("V2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("L4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("Y2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("M4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("V2").Offset(tracmo, 0).Select
    Application.CutCopyMode = False
    Selection.Copy

    Range("L5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

   Range("Y2").Offset(tracmo, 0).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("M5").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("L11").Select
    ActiveSheet.ChartObjects("Graphique 1").Activate
    ActiveSheet.ChartObjects("Graphique 1").Activate
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(2).XValues = "='carac5'!$M$8:$M$9"
    ActiveChart.SeriesCollection(2).Values = "='carac5'!$L$8:$L$9"

Range("L6").Select
ActiveCell.FormulaR1C1 = "=SLOPE(R[-2]C[0]:R[-1]C[0],R[-2]C[1]:R[-1]C[1])"
Range("M8").Select
ActiveCell.FormulaR1C1 = "Module (GPa)"
Range("N8").Select
ActiveCell.FormulaR1C1 = "=R[-2]C[-2]/10"

Range("M9").Select
ActiveCell.FormulaR1C1 = "Def résiduelle"
Range("N9").Select
ActiveCell.FormulaR1C1 = "=R[-4]C[-1]"

Range("M10").Select
ActiveCell.FormulaR1C1 = "Def à ctr max"
Range("N10").Select
ActiveCell.FormulaR1C1 = "=R[-6]C[-1]"

dec = -1 + h

    Range("N8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Ensemble_module").Select
    Range("B2").Offset(dec, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Sheets("carac" & h).Select

    Range("N9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Ensemble_module").Select
    Range("C2").Offset(dec, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Sheets("carac" & h).Select

    Range("N10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Ensemble_module").Select
    Range("D2").Offset(dec, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Sheets("Essai1.steps.Tracking").Select

Range(Range("A1").Offset(1, 0), Range("J1").Offset(nombrecar, 0)).Select
    Selection.EntireRow.Delete

End With

Next h

Sheets("Ensemble_module").Select

Range("L11").Select

ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).Name = "module secant"
    ActiveChart.SeriesCollection(1).XValues = "='Ensemble_module'!$A$2:$A$51"
    ActiveChart.SeriesCollection(1).Values = "='Ensemble_module'!$B$2:$B$51"

Range("N11").Select
  ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).Name = "def residuelle"
    ActiveChart.SeriesCollection(1).XValues = "='Ensemble_module'!$A$2:$A$51"
    ActiveChart.SeriesCollection(1).Values = "='Ensemble_module'!$C$2:$C$51"

Range("O11").Select
  ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).Name = "def a ctr max"
    ActiveChart.SeriesCollection(1).XValues = "='Ensemble_module'!$A$2:$A$51"
    ActiveChart.SeriesCollection(1).Values = "='Ensemble_module'!$D$2:$D$51"

End Sub
Le 03/06/2015 à 21:04

Bonsoir,

beaucoup de ".Select" dans cette Sub !

Il y a du nettoyage à faire, en effet il n'est pas nécessaire à chaque fois de sélectionner une ou des cellules pour travailler dedans.

Le faite de faire une sélection, c'est mettre quelque chose en mémoire (je pense) et après cela nécessite de la ressource pour le gérer, donc du temps de calcul.

En parlant de temps de calcul (et autre) voici une astuce pour accélérer votre code sans rien (ou presque) modifier :

Ajoutez ces quelques lignes en début de Sub :

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlManual

Dans l'ordre, cela à pour objectif de :

Arrêter la mise à jour de l'écran, et au vu du nombre de sélection cela fera gagner beaucoup de temps,

Arrêter la surveillance événementielle au cas où vous en auriez mis en place,

Arrêter le calcul automatique, en effet à chaque changement de valeur d'une cellule sur une feuille, le calcul de la feuille voir du classeur est lancé pour tout mettre à jour, et au vu du nombre de modification sur votre classeur cela fera gagner beaucoup de temps également. Attention !!! Si lors de vos modifications vous avez besoin d'un calcul du à ces modifications alors ne mettez pas cette troisième ligne...

Ensuite en fin de Sub vous mettez les mêmes lignes en ordre inverse avec True au lieu de False !

comme ceci :

    Application.Calculation = xlAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True

Attention tout de même, un arrêt de surveillance événementiel non remis en marche fait que le tableur est inopérant car aucun événement est détecté, donc bien penser à tout remettre sur "True"

voilà, faites le test et revenez nous dire ce que cela donne...

Si vraiment le code met encore trop de temps (environ plus de 7 secondes, c'est le temps moyen que les utilisateurs sont "d'accord" d'attendre pour l'exécution d'une macro) alors il faudra travailler sur la suppression des divers select en trop.

@ bientôt

LouReeD

Le 03/06/2015 à 22:06

En effet, bcp de select inutiles. Par exemple les premières affectations de valeurs pourraient être du type :

    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Ensemble_module"
    Range("A1") = "Tps (hr)"
    Range("B1") = "Module secant GPa"
    Range("C1") = "Def résiduelle"
    Range("D1") = "Def a ctr max"
    Range("A2") = "7"
    Range("A3") = "14"
    Range("A4") = "21"
    Range("A3:A4").Select
    Selection.AutoFill Destination:=Range("A3:A51"), Type:=xlFillDefault

Par ailleurs je pense que le code

Range(Range("A1").Offset(1, 0), Range("J1").Offset(nombreoxy, 0)).Select
    Selection.Copy
    Sheets("Oxydation").Select
    Range("A2").Select
    ActiveSheet.Paste

Pourrait être remplacé par

Sheets("Oxydation").Range("A2") = Range(Range("A1").Offset(1, 0), Range("J1").Offset(nombreoxy, 0))

Et je suis d'accord avec LouReeD (que je salue) pour les mentions Application.ScreenUpdating = False en début de macro puis = True en fin de macro.

Rechercher des sujets similaires à "optimisation vba"