Réduction temps d'exécution de macro

Version imprimable

Bonjour à tous,

Petit soucis concernant ma macro, qui peut mettre de 15sec à faire planter le fichier en fonction des calculs demandés. Sachez que malheureusement je ne pourrai fournir que le code, les données étant confidentielles.

Je m'explique :

J'ai créé un fichier capable de regrouper les frais de fonctionnement en fonction de comptes comptables au préalablement mappés.

L'utilisateur choisit via un userform les centres de frais qu'il souhaite analyser. J'ai alors plusieurs macro qui viennent coller ces valeurs sur les colonnes de restitution. Cela se fait facilement et rapidement. Mon problème n'est pas là.

Pour info, la macro va aller comparer les deux premières valeurs avec le mapping (qui se trouve sur une autre page). Cela fait donc une exécution par ligne via des boucles.

Mes calculs s'executent en trois parties :

- Somme ligne par ligne des sections en fonction du mapping, via ce code
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 Sub calculCDACT2() Dim TYPECPN As String Dim TYPECC As String Dim TOTALCT As Double Dim colonneCDAEXTRAC As Integer Dim s As Integer Dim k As Integer Dim i As Integer Dim n As Integer Dim r As Integer Dim dercol As Integer Dim dercol2 As Integer Dim derligne As Integer Dim derligne2 As Integer On Error Resume Next dercol = ThisWorkbook.Sheets("Cost Center Costs").Cells(3, Columns.Count).End(xlToLeft).Column dercol2 = ThisWorkbook.Sheets("Extraction").Cells(1, Columns.Count).End(xlToLeft).Column derligne = ThisWorkbook.Sheets("Cost Center Costs").Range("A" & Rows.Count).End(xlUp).Row derligne2 = ThisWorkbook.Sheets("Extraction").Range("A" & Rows.Count).End(xlUp).Row 'POUR CHAQUE LIGNE DE COST CENTER, s = ligne à utiliser dans "Cost Center Costs" pour afficher le montant For s = 4 To derligne - 1 TYPECC = ThisWorkbook.Sheets("Cost Center Costs").Cells(s, 1).Value & ThisWorkbook.Sheets("Cost Center Costs").Cells(s, 2).Value 'RECHERCHE DE LA CPN DE LA COLONNE DE COST CENTER DANS EXTRAC ET RECUPERATION DE LA COLONNE For n = 3 To dercol 'n = colonne à utiliser dans "Cost Center Costs" pour afficher le montant TOTALCT = 0 'RECHERCHE DU COST CENTER TYPE ASSOCIE AU COMPTE, i = ligne pour trouver le montant dans "Extraction" For i = derligne2 To 2 Step -1 TYPECPN = Application.VLookup(ThisWorkbook.Sheets("Extraction").Cells(i, 1).Value, ThisWorkbook.Sheets("Mapping CPN").Range("A:G"), 7, False) 'SI COST CENTER COMPTE = COST CENTER ALORS If TYPECPN = TYPECC Then 'RECHERCHE DANS EXTRACTION For r = 3 To dercol2 ' If ThisWorkbook.Sheets("cost center costs").Cells(3, n).Value = ThisWorkbook.Sheets("Extraction").Cells(1, r).Value Then colonneCDAEXTRAC = ThisWorkbook.Sheets("Extraction").Cells(1, r).Column Else End If Next r 'colonneCDAEXTRAC =colonne pour trouver le montant dans "Extraction" TOTALCT = TOTALCT + ThisWorkbook.Sheets("Extraction").Cells(i, colonneCDAEXTRAC).Value Else TOTALCT = TOTALCT End If Next i If IsNumeric(ThisWorkbook.Sheets("Cost Center Costs").Cells(s, 1).Value) = True Or IsEmpty(ThisWorkbook.Sheets("Cost Center Costs").Cells(s, 2).Value) = True Then ThisWorkbook.Sheets("Cost Center Costs").Cells(s, n).Value = ThisWorkbook.Sheets("Cost Center Costs").Cells(s, n).Value Else ThisWorkbook.Sheets("Cost Center Costs").Cells(s, n).Value = TOTALCT / 1000 End If Next n Next s End Sub
- Regroupement des différentes parties, avec la même macro, mais qui ne va aller viser que la première colonne.

- Puis un total, qui au final s'exécute en second, ou je somme toute la colonne.

J'ai bien des résultats si je ne choisis que deux ou trois Cost Centers.

Là où ça se complique c'est quand je vais avoir une dizaine de Cost Centers à évaluer. Je n'ai jamais pu aller au bout de la macro, le temps de traitement est bien trop long.

Si vous avez une solution sur ce premier bout de code, je vous en serai reconnaissant. A l'inverse j’essaierai de vous communiquer le maximum d'infos.

EDIT : J'ai également un soucis, si la valeur de la colonne n'est pas présente dans l'extraction, cela me copie la valeur précédente trouvée. Je n'arrive pas à trouver ou placer le TOTALCT = 0 pour annuler cela, avec une condition.

Merci d'avance pour votre aide,

Cordialement,

Bonjour Ecell, bonjour le forum,

Peut-être en utilisant des variables tableau (TCCC et TE) ça ira plus vite. Si je ne me suis pas trompé ça donne ça :

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
Sub calculCDACT2()
Dim CCC As Worksheet
Dim E As Worksheet
Dim MC As Worksheet
Dim TCCC As Variant
Dim TE As Variant
Dim TYPECPN As String
Dim TYPECC As String
Dim TOTALCT As Double
Dim colonneCDAEXTRAC As Integer
Dim s As Integer
Dim k As Integer
Dim i As Integer
Dim n As Integer
Dim r As Integer
Dim dercol As Integer
Dim dercol2 As Integer
Dim derligne As Integer
Dim derligne2 As Integer
 
Set CCC = Worksheets("Cost Center Costs")
Set E = Worksheets("Extraction")
Set MC = Worksheets("Mapping CPN")
TCCC = CCC.Range("A3").CurrentRegion
TE = E.Range("A1").CurrentRegion
 
On Error Resume Next
 
dercol = UBound(TCCC, 2) ' CCC.Cells(3, Columns.Count).End(xlToLeft).Column
dercol2 = UBound(TE, 2) ' E.Cells(1, Columns.Count).End(xlToLeft).Column
derligne = UBound(TCCC, 1) 'CCC.Range("A" & Rows.Count).End(xlUp).Row
derligne2 = UBound(TE, 1) 'E.Range("A" & Rows.Count).End(xlUp).Row
 
'POUR CHAQUE LIGNE DE COST CENTER, s = ligne à utiliser dans "Cost Center Costs" pour afficher le montant
For s = 4 To derligne - 1
    TYPECC = TCCC(s, 1) & TCCC(s, 2) 'CCC.Cells(s, 1).Value & CCC.Cells(s, 2).Value
    'RECHERCHE DE LA CPN DE LA COLONNE DE COST CENTER DANS EXTRAC ET RECUPERATION DE LA COLONNE
    For n = 3 To dercol 'n = colonne à utiliser dans "Cost Center Costs" pour afficher le montant
        TOTALCT = 0
        'RECHERCHE DU COST CENTER TYPE ASSOCIE AU COMPTE, i = ligne pour trouver le montant dans "Extraction"
        For i = derligne2 To 2 Step -1
            TYPECPN = Application.VLookup(TE(i, 1), MC.Range("A:G"), 7, False)
            'SI COST CENTER COMPTE = COST CENTER ALORS
            If TYPECPN = TYPECC Then
                'RECHERCHE DANS EXTRACTION
                For r = 3 To dercol2 '
                    If TCCC(3, n) = TE(1, r) Then colonneCDAEXTRAC = r
                Next r
                'colonneCDAEXTRAC =colonne pour trouver le montant dans "Extraction"
                TOTALCT = TOTALCT + TE(i, colonneCDAEXTRAC)
            Else
                TOTALCT = TOTALCT
            End If
        Next i
        If IsNumeric(TCCC(s, 1)) = True Or IsEmpty(TCCC(s, 2)) = True Then
            CCC.Cells(s, n).Value = CCC.Cells(s, n).Value
        Else
            CCC.Cells(s, n).Value = TOTALCT / 1000
        End If
    Next n
Next s
End Sub

28/01/2019, 11h30
ecell

Hello Thauthem,

Merci pour ta réponse ! En effet cela diminue le temps de calcul mais j'ai des valeurs qui ne sont plus calculées (comparaison ancienne macro et nouvelle).

Certaines lignes sont maintenant à 0 alors qu'elles devraient être renseignées. Je cherche d'où ça vient et je te tiens au courant.

Merci encore,

Cordialement,
28/01/2019, 12h12
ecell

Je pense avoir trouvé :

Si j'utilise

Code:

TYPECC = CCC.Cells(s, 1) & CCC.Cells(s, 2)

à la place de

Code:

TYPECC = TCCC(s, 1) & TCCC(s, 2)

Les montants reviennent à la normale. Je ne sais pas si il n'y a pas de sauts dans les boucles...
28/01/2019, 13h59
Thautheme

Re,

En effet. Comme j'ai utilisé CurrentRegion pour définir le tableau TCCC je ne sait pas quelle est la première ligne du tableau et j'ai oublié d'adapter. Pour être sûr, il faudrait que tu places le curseur dans la cellule A3 est que tu fasses [Ctrl]+[*] du pavé numérique (ça équivaut au CurrentRegion). Là, tu regardes quelle est la première ligne de la sélection. En fonction de ça on adapte le code...
Si la première ligne de la sélection est la ligne 3, il y a un décalage enter la ligne réelle de la boucle ou s commence a 4. Dans ce cas, CCC.Cells(s ,1).Value équivaut à TCCC(s-2, 1). Si on veut conserver les données des variables tableau le code de cette ligne serait :

Code:

TYPECC = TCCC(s-2, 1) & TCCC(s-2, 2)
28/01/2019, 17h07
ecell

C'est tout bon !!

Réduction immédiate du temps d'exécution, je te remercie pour l'idée et les quelques améliorations de code que tu as glissées.

Sujet clos, merci beaucoup !