Optimisation vitesse de calcul

Version imprimable

Bonjour à tous, 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? Derlign vaut "221" et dercol "52".
Et la TabBDD dispose de 55000 lignes et 51 colonnes

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
Private Sub RemplissageTableau()
Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    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
                   ElseIf (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
                   ElseIf (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
Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Merci à vous

30/11/2017, 10h46
unparia

Citation:

Est ce qu'il y aurait une écriture différente afin d'optimiser la vitesse de calcul?

"Ecriture" ? -->> non
Méthodes différentes ? --->> oui --->> par exemple : constituer un tableau dynamique -->> travailler sur les éléments de ce tableau --->> réinjecter les valeurs du tableau
Tu trouveras des sources déposées concernant ce mécanismes (utilisation du moteur de recherche de ce forum).
30/11/2017, 10h52
unparia

Tu devrais par ailleurs commencer à t'intéresser à ce que t'offrent les différentes méthodes de l'objet WorkSheetFunction, notamment en ce qui concerne la détermination de totaux ;)

Bref ... Je répondrais personnellement ainsi à ta question : --->> reprendre tout à zéro et dans un esprit/démarche totalement différent.

EDIT : pour être clair et par analogie : utiliser du super 98 pour alimenter un moteur 5 CV "trèfle" (de Citroën, pour ceux qui, âgés, connaissent) ne transformera pas en bolide le véhicule doté de ce moteur. Si l'on veut un bolide, il faut également en changer le moteur lui-même.
30/11/2017, 11h21
Florian53

Citation:

Envoyé par unparia

"Ecriture" ? -->> non
Méthodes différentes ? --->> oui --->> par exemple : constituer un tableau dynamique -->> travailler sur les éléments de ce tableau --->> réinjecter les valeurs du tableau
Tu trouveras des sources déposées concernant ce mécanismes (utilisation du moteur de recherche de ce forum).

Dans mon code, je passe déjà par un tableau:

Code:

tabBDD = Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 30))

ce n'est pas de ça que tu veux parler?

Peux tu me montrer la démarche pour construire le code que tu essayes de m'expliquer ?
30/11/2017, 11h25
unparia

Ce n'est pas de "cela" (ce tableau-là), dont je veux parler, mais de ce genre-là
Si tu le "cernes", il est à appliquer ailleurs également dans ton code.
Notamment tout ce qui est dans ton bloc :

Code:

With wsResult

Il faudrait que je renseigne "Wsresult" comme tableau comme pour "TabBDD"

Comme ceci ?

Code:

1
2
3
4
5
6
7
 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
       tabBDD2 = Range(.Cells(2, 4), .Cells(.Cells(Rows.Count, 2).End(xlUp).Row, Cells(1, Cells.Columns.Count).End(xlToLeft).Offset(0, 0).Column))

30/11/2017, 12h18
unparia

Si tu veux ...
Mais il te faut ensuite t'en servir ! C'est là, l'essentiel : t'en servir !
Je crois que je vais maintenant te laisser. On ne peut transformer une discussion en cours complet.
30/11/2017, 13h43
Igloobel

Bonjour,

Si certain calcul peuvent être fait en formules tu gagneras du temps d'exécution de la macro car cela supprimera l'exécution par macro puisque tu passes par une formule.

personnellement j'avais ce même type de problème une macro prenant trop de temps qui provoquait une anomalie inexistante c'est à dire qu'il suffisait de relancer le contrat pour qu'il passe)

La macro faisait entre 0.8s et 1.15s or le temps qu'il m'était imparti c'est 0.4s du coup en optimisant par les formules puis en regroupant des calculs je suis descendu à 0.3s

Je te dis cela comme une piste à explorer

@+