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,