Accélération exécution macro

Version imprimable

Bonjour à tous, j'ai fait le code ci dessous et je voudrais savoir si cette méthode est correct niveau optimisation de la vitesse d'éxécution ou une autre méthode plus rapide existe ?

Code:

1
2
3
4
For i = 4 To 53 Step 13
 
        Range(Cells(i, n + 1), Cells(i, n + 1)).Formula = (Cells((i - 1), 7) + Cells((i - 1), n) - Cells((i - 1), n - 1)) / ((Cells((i + 10), 4) + Cells((i + 10), n) - Cells((i + 10), n - 1)))
Next i

J'ai réalisé un fichier excel qui comporte énormément de macro, et la vitesse d'éxécution de l'ensemble des macros est de 1 minutes et 15 secondes.

J'essaye de gratter un peu partout, en enlevant des "select" et en re structurant certain code dont celui ci afin de gagner quelques secondes par ci par là.

Voici mon code en entier:

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
Private Sub MG12()
Dim i As Integer
Dim j&, jj&
 
With Sheets("Cout")
 
'Création du 12Mg, ce code repère si il y a 2 "YTD" auquel cas il ajoute une colonne après 
For n = Cells(1, Columns.Count).End(xlToLeft).Column To 3 Step -1
   If Left(Cells(1, n), 10) Like "YTD *" And Left(Cells(1, n - 1), 10) Like "YTD *" And Left(Cells(1, n), 11) = Left(Cells(1, n - 1), 11) Then
        Columns(n + 1).Insert Shift:=xlShiftToRight
 
 
        jj = Cells.Find("*", , , , xlByColumns, xlPrevious).Column 'Dernière colonne
    For j = 3 To jj
    If Cells(1, j).Value = "Réel " & Right(Cells(1, n - 1), 4) Then Exit For
    Next
 
'Écriture 12Mg en entête de la colonne insérée
        Cells(1, n + 1).Value = "12mg " & Right(Cells(1, n), 7)
 
'Calcul des cellules de la colonne 12Mg
For i = 2 To 53
        Range(Cells(i, n + 1), Cells(i, n + 1)).Formula = Cells(i, j) + Cells(i, n) - Cells(i, n - 1)
Next i
 
' Calcul du critete % ASS de la colonne 12Mg
For i = 4 To 53 Step 13
        Range(Cells(i, n + 1), Cells(i, n + 1)).Formula = (Cells((i - 1), 7) + Cells((i - 1), n) - Cells((i - 1), n - 1)) / ((Cells((i + 10), 4) + Cells((i + 10), n) - Cells((i + 10), n - 1)))
Next i
 
' Calcul du critere % E/R de la colonne 12Mg
For i = 8 To 53 Step 13
        Range(Cells(i, n + 1), Cells(i, n + 1)).Formula = (Cells((i - 3), 7) + Cells((i - 3), n) - Cells((i - 3), n - 1)) / ((Cells((i + 6), 4) + Cells((i + 6), n) - Cells((i + 6), n - 1)))
Next i
 
   End If
Next
End With
 
End Sub

30/11/2017, 07h25
unparia

Bonjour

Déjà : analyse donc ceci calmement :

Citation:

If Left(Cells(1, n), 10) Like "YTD *" And Left(Cells(1, n - 1), 10) Like "YTD *" And Left(Cells(1, n), 11) = Left(Cells(1, n - 1), 11) Then

Traduis-le dans ta pensée et allège-moi ceci, s'il te plait (question de logique TRES élémentaire ). ;)

EDIT : Un peu de réflexion, quand-même (la réflexion est la base du développement)

Compare donc (analogie)

Si Pierre est blond et que Paul est blond et que Pierre pèse 65 kilogs et que le poids de Paul est celui de Pierre

avec

Si Pierre est blond et pése 65 kilogs et que Paul = Pierre

Bonjour,
Difficile à dire si tu gagnerais pas du temps avec une seule boucle!

Code:

1
2
3
4
5
For i = 2 To 53
        debug.print Cells(i, n + 1).address
        debug.print Cells(i, n + 1).offset(2).address
        debug.print Cells(i, n + 1).Offset(4).address
Next i

30/11/2017, 07h42
Florian53

Bonjour Unparia

Une simplification de "Like "YTD" .

Code:

If Left(Cells(1, n), 10) and Left(Cells(1, n - 1), 10) And Left(Cells(1, n), 11) Like "YTD *" = Left(Cells(1, n - 1), 11) Then

J’espère que c'est la réponse à laquelle tu t'attendais :lol::lol::lol:

Merci à toi
30/11/2017, 07h43
unparia

Réfléchis encore plus (et lis mon édit). ;)
30/11/2017, 07h43
Florian53
Citation:
Envoyé par dysorthographie

Bonjour,
Difficile à dire si tu gagnerais pas du temps avec une seule boucle!

Code:

1 2 3 4 5 For i = 2 To 53 debug.print Cells(i, n + 1).address debug.print Cells(i, n + 1).offset(2).address debug.print Cells(i, n + 1).Offset(4).address Next i
Salut dysorthographie,

Si sa n’accélère pas le code sa à aura au moins le mérite de diminuer les lignes de code. Je vais essayer sa afin de comparer les vitesses d’exécution.
30/11/2017, 07h50
Florian53

Citation:

Envoyé par unparia

Réfléchis encore plus (et lis mon édit). ;)

:oops::oops: je suis en train de me faire un tas de noeud dans ma tête et je ne vois pas la simplification à laquelle tu veux venir.
30/11/2017, 07h54
unparia

Citation:

et je ne vois pas la simplification à laquelle tu veux venir

Prends un café, repose-toi et réfléchis avec calme :coucou:

L'informatique a vraiment très peu à voir, dans cette affaire. La logique, ENORMEMENT.

EDIT : Allons, allons !
Je vais m'adresser au technicien de maintenance :
Tu cherches à savoir si les n premiers caractères d'une référence R1 sont de type "XXXX ...." et égaux aux n premiers caractères d'une référence R2.

Code:

If Left(R1,n) Like "XXXX*" and left(R2,n) = left(R1,n)

suffit, non ???
30/11/2017, 09h16
Florian53

Merci unparia, pour ton aide. il va falloir que je m’entraîne à être plus logique :roll::roll:

Citation:

Envoyé par unparia

Bonjour

Déjà : analyse donc ceci calmement :

Traduis-le dans ta pensée et allège-moi ceci, s'il te plait (question de logique TRES élémentaire ). ;)

EDIT : Un peu de réflexion, quand-même (la réflexion est la base du développement)

Compare donc (analogie)

Si Pierre est blond et que Paul est blond et que Pierre pèse 65 kilogs et que le poids de Paul est celui de Pierre

avec

Si Pierre est blond et pése 65 kilogs et que Paul = Pierre

Est ce que je peux me permettre de te demander une astuce aussi pour le code ci dessous:

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
Private Sub RemplissageTableau()
Dim tabBDD()
Dim wsBDD As Object
Dim wsResult As Object
Dim som(9)
Dim crit(6)
Dim cptBDD
Dim i, j As Long
 
        Set wsBDD = Worksheets("BDD")
        Set wsResult = Worksheets("Familly & Country")
 
With wsBDD
    tabBDD = Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 30)) ' Définition du tableau de travail
End With
 
With wsResult
derlig = Cells(Rows.Count, 2).End(xlUp).Offset(0, 0).Row
dercol = Cells(1, Cells.Columns.Count).End(xlToLeft).Offset(0, 0).Column
 
    For i = 2 To derlig Step 4
 
        For j = 4 To dercol
    som1 = 0
    som2 = 0
    som3 = 0
    som4 = 0
    som5 = 0
    som6 = 0
    som7 = 0
    som8 = 0
    som9 = 0
 
    crit2 = Sheets("Données").Cells(4, 2)  'Réel
   crit3 = Sheets("Familly & Country").Cells(i, 1) ' Country
   crit4 = Sheets("Familly & Country").Cells(1, j) 'Familly
   crit5 = Sheets("Données").Cells(5, 2) 'YTD  n
   crit6 = Sheets("Données").Cells(6, 2) 'YTD  n-1
 
                For cptBDD = 1 To UBound(tabBDD, 1)
 
                        If (tabBDD(cptBDD, 1) = crit2) And (tabBDD(cptBDD, 30) = crit3) And (tabBDD(cptBDD, 24) = crit4) Then
                        som1 = som1 + tabBDD(cptBDD, 11) 'total1
                       som2 = som2 + tabBDD(cptBDD, 12) 'total2
                       som3 = som3 + tabBDD(cptBDD, 14) + tabBDD(cptBDD, 15) + tabBDD(cptBDD, 16) + tabBDD(cptBDD, 18) + tabBDD(cptBDD, 20) 'total3
                       End If
 
                        If (tabBDD(cptBDD, 1) = crit5) And (tabBDD(cptBDD, 30) = crit3) And (tabBDD(cptBDD, 24) = crit4) Then
                        som4 = som4 + tabBDD(cptBDD, 11) 'total1
                       som5 = som5 + tabBDD(cptBDD, 12) 'total2
                       som6 = som6 + tabBDD(cptBDD, 14) + tabBDD(cptBDD, 15) + tabBDD(cptBDD, 16) + tabBDD(cptBDD, 18) + tabBDD(cptBDD, 20) 'total3
                       End If
 
                        If (tabBDD(cptBDD, 1) = crit6) And (tabBDD(cptBDD, 30) = crit3) And (tabBDD(cptBDD, 24) = crit4) Then
                        som7 = som7 + tabBDD(cptBDD, 11) 'total1
                       som8 = som8 + tabBDD(cptBDD, 12) 'total2
                       som9 = som9 + tabBDD(cptBDD, 14) + tabBDD(cptBDD, 15) + tabBDD(cptBDD, 16) + tabBDD(cptBDD, 18) + tabBDD(cptBDD, 20) 'total3
                       End If
                Next
 
    .Cells(i, j) = som1 + som4 - som7 'Total 1
   .Cells(i + 1, j) = (som2 + som5 - som8) Total 2
    .Cells(i + 2, j) = ((som3 + som6 - som9) * -1) 'Total 3
       If (som2 + som5 - som8) <= 0 Then
        .Cells(i + 3, j) = 0
        Else
        .Cells(i + 3, j) = ((som3 + som6 - som9) * -1) / (som2 + som5 - som8) ' %Total
       End If
 
Next
Next
End With
 
Cells.EntireColumn.AutoFit
 
End Sub

j'ai réalisé la macro ci dessous:

Elle fonctionne parfaitement par contre son temps d’exécution est d'environ 2 minutes, c'est la boucle " For i " qui prends enormement de temps.

Est ce qu'il y aurait une écriture différente afin d'optimiser la vitesse de calcul? Les valeurs de Derlign sont "221" et dercol "52".

30/11/2017, 09h47
unparia

Citation:

il va falloir que je m’entraîne à être plus logique

et plus lucide également !
Regarde :
dans

Code:

Range(Cells(i, n + 1), Cells(i, n + 1)).Formula = Cells(i, j) + Cells(i, n) - Cells(i, n - 1)

1) que pourrait bien être

Code:

Range(Cells(i, n + 1), Cells(i, n + 1))

sinon Range(Cells(i, n + 1)), et finalement :

Code:

Cells(i, n + 1)

tout simplement ?
2) Il est abusif d'utiliser la propriété Formula pour ne finalement spécifier qu'une valeur --->> propriété Value
3) toujours préciser la propriété à utiliser et ne pas laisser VBA deviner celle qui convient !
La voilà, ta ligne corrigée :

Code:

Cells(i, n + 1).Value = Cells(i, j).value + Cells(i, n).value - Cells(i, n - 1).Value

Sans préjudice du reste de tes lignes de code. (Il y aurait beaucoup trop à dire ...)
30/11/2017, 09h51
Florian53

Merci à toi, je vais pouvoir appliquer cette logique sur les autres lignes de code
30/11/2017, 19h22
Marc-L

'soir !

Sans boucle via le B-A-BA d'Excel : une simple formule de calculs !

___________________________________________________________________________________________________________
Je suis Paris, Egypte, Nigeria, New-York, Mogadicio, Barcelone, London, Manchester, Stockholm, Istanbul, Berlin, Nice, Bruxelles, Charlie, …