Réduction temps d'exécution de macro

**ecell** · 28/01/2019, 10h47

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 :

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
 
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,

**Thautheme** · 28/01/2019, 12h19

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 :

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

**ecell** · 28/01/2019, 12h30

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,

**ecell** · 28/01/2019, 13h12

Je pense avoir trouvé :

Si j'utilise

Code :

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

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

à la place de

Code :

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

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

**Thautheme** · 28/01/2019, 14h59

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 :

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

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

**ecell** · 28/01/2019, 18h07

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 !

Réduction temps d'exécution de macro [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager