Accélération exécution macro

**Florian53** · 30/11/2017, 07h18

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 vb :

Sélectionner tout - Visualiser dans une fenêtre à part

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 vb :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**unparia** · 30/11/2017, 07h25

Bonjour

Déjà : analyse donc ceci calmement :

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

**Florian53** · 30/11/2017, 07h42

Bonjour Unparia

Une simplification de "Like "YTD" .

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Merci à toi

**unparia** · 30/11/2017, 07h43

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

**Florian53** · 30/11/2017, 07h50

Envoyé par unparia

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

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.

**unparia** · 30/11/2017, 07h54

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

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

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

suffit, non ???

**Florian53** · 30/11/2017, 09h42

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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".

Invité · 30/11/2017, 07h38

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Florian53** · 30/11/2017, 07h43

Envoyé par dysorthographie

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

Accélération exécution macro

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager