Discussion :

[Pascale B.]

Bonjour le forum!

J'ai besoin de vos précieux conseils afin d'augmenter le temps d'exécution de ma macro.

Voici la description: Le fichier possède un onglet qui s'appel "Exportation". Dans cet onglet, je concatène dans une même colonne le contenu de trois colonnes, soit une date, un numéro de route et un numéro de course. Dans la colonne AQ il y a des codes de paiements qui sont inscrits. Il y a une possibilité de 39 codes de paiements différents.
Après avoir concaténer, je colle cette nouvelle colonne dans un autre onglet nommé "Données" puis je supprime les doublons. J'ai donc dans la colonne A de mon onglet "Données" toutes les valeurs unique et dans les cellules G1 à AM1 il y a tous les codes de paiement possibles.
Pour chacune des valeurs unique, je dois savoir combien il y eu de code de paiement.
Voici un exemple de l'onglet "Exportation"


Voici ce à quoi doit ressembler l'onglet "Données" au final:


Voici le code que j'avais créer au départ:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
    'Pour chaque cellule de la colonne G à AM, Compte le nombre code de paiement
    'Défini la colonne dans une variable
        i = 7
        Do While i <= 39
            Set c = Sheets("Exportation").Range("AQ2:A" & DernLigne).Find(Range(Split(Columns(i).Address(ColumnAbsolute:=False), ":")(1) & 1).Value, LookIn:=xlValues)
            If Not c Is Nothing Then
                For Each cell In Range(Split(Columns(i).Address(ColumnAbsolute:=False), ":")(1) & "2:" & Split(Columns(i).Address(ColumnAbsolute:=False), ":")(1) & DernLigne)
                    MaValeur = Range("A" & cell.Row).Value
                    Range(Split(Columns(i).Address(ColumnAbsolute:=False), ":")(1) & cell.Row).Value = WorksheetFunction.CountIfs(Sheets("Exportation").Columns("A"), MaValeur, Sheets("Exportation").Columns("AQ"), Range(Split(Columns(i).Address(ColumnAbsolute:=False), ":")(1) & "1"))
                Next
            End If
        i = i + 1
        Loop

Mais la macro est beaucoup trop longue, j'ai donc fait des recherches et j'ai appris qu'en stockant nos données dans un tableau, la recherche devait être beaucoup plus rapide. Je vais être honnête avec vous, étant néophyte et autodidacte, j'ai trouvé un code sur internet que j'ai copié et essayé d'adapter à mon besoin, mais ça ne fonctionne toujours pas, ma macro est plus longue. J'arrive à mettre mes données dans le tableau mais je ne sais pas comment faire la recherche par la suite. J'utilise encore un for each cell et ce n'est surement pas la bonne méthode.

Voici mon nouveau 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
Dim code_paiement As String, numero As Integer, compteur As Integer, ligne As Integer, j As Integer
Dim tableau()
ReDim tableau(DernLigne - 1, 1)
'Numéro du premier enregistrement dans le tableau
    numero = 0
'Enregistrement des données dans le tableau
    For ligne = 2 To DernLigne
        tableau(numero, 0) = Sheets("Exportation").Range("A" & ligne) 'Mavaleur
        tableau(numero, 1) = Sheets("Exportation").Range("AQ" & ligne) 'code de paiement
        numero = numero + 1
    Next
'Redéfini la dernière ligne à cause des valeurs unique
    DernLigne = Range("a" & Rows.Count).End(xlUp).Row
'Défini la colonne - à partir de la colonne G
    j = 7
'Jusqu'à la colonne AM
    Do While j <= 39
        For Each cell In Range(Split(Columns(j).Address(ColumnAbsolute:=False), ":")(1) & "2:" & Split(Columns(j).Address(ColumnAbsolute:=False), ":")(1) & DernLigne)
            code_paiement = Range(Split(Columns(j).Address(ColumnAbsolute:=False), ":")(1) & "1").Value
            compteur = 0
                For i = 0 To numero - 1
                    MaValeur = Range("A" & cell.Row).Value
                    If tableau(i, 0) = MaValeur And tableau(i, 1) = code_paiement Then compteur = compteur + 1
                Next
            Cells(cell.Row, j) = compteur
         Next
         j = j + 1
    Loop

Voilà, j'espère avoir bien respecter les règles du forum et avoir bien décrit mon problème. Si quelqu'un avait une piste de solution pour moi, ce serait vraiment gentil!

Bonne journée!

[Invité]

Bonjour,

Que donne ce code qui crée un TCD depuis votre onglet Exportation une fois vos doublons supprimés :

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
 
Option Explicit
 
Sub CreationTcdExportation()
 
Dim ShTcd As Worksheet
Dim AireExport As Range
Dim Pvt As PivotTable
Dim I As Integer
 
    For I = Sheets.Count To 1 Step -1
        Application.DisplayAlerts = False
        If Sheets(I).Name = "Données EK" Then Sheets(I).Delete
        Application.DisplayAlerts = True
    Next I
 
    Set AireExport = Sheets("Exportation").UsedRange
    Set ShTcd = Sheets.Add
 
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=AireExport).CreatePivotTable _
    TableDestination:=ShTcd.Range("A10"), TableName:="TcdExport"
 
    With ShTcd
        .Name = "Données EK"
        Set Pvt = .PivotTables("TcdExport")
        With Pvt
                With .PivotCache
                    .RefreshOnFileOpen = False
                    .MissingItemsLimit = xlMissingItemsDefault
                End With
                .RepeatAllLabels xlRepeatLabels
                With .PivotFields("Valeur unique")
                    .Orientation = xlRowField
                    .Position = 1
                End With
                .AddDataField .PivotFields("Code de paiement"), "Nombre de Code de paiement", xlCount
                With .PivotFields("Code de paiement")
                    .Orientation = xlColumnField
                    .Position = 1
                End With
                .InGridDropZones = True
                .RowAxisLayout xlTabularRow
 
                With .DataBodyRange
                     .HorizontalAlignment = xlCenter
                     .ColumnWidth = 12
                End With
 
                With .RowRange
                    .HorizontalAlignment = xlCenter
                End With
 
                With .ColumnRange
                    .HorizontalAlignment = xlCenter
                End With
 
 
           End With
    End With
 
End Sub

Pièce jointe 596534

[Pascale B.]

Bonjour Eric,

Je vous remercie infiniment d'avoir pris le temps de lire ma problématique et d'y avoir apporté une solution.

La seule chose c'est que cette solution m'apporte une autre problématique puisque qu'il y a une suite à ma macro dont je ne vous ai pas parler: À la fin de tous les codes de paiements j'ai d'autres colonnes qui font des calculs sur certaines colonnes précises.



Par exemple, la colonne BO additionne les colonnes AC à AF puis BE à BH puis AI et BK. Comme ce ne sont pas tous les même codes de paiement qui sont utilisés à chaque mois et qu'ils ne sont pas tous utilisés en faisant un tableau croisé dynamique, les codes de paiements ne se retrouvent pas tous aux mêmes endroits.

C'est la raison pour laquelle j'utilisais la façon démontré dans mon premier message, mais s'il y avais un moyen dans le tableau croisé dynamique d'indiquer "si le code de paiement = x, y ou z" fait le total dans une colonne, je serais bien ouverte à utiliser cette méthode, seulement mes compétences en programmation ne vont pas jusque là. Si vous pouviez m'indiquer si cela est possible et me donner une piste de recherche, je tenterais volontiers d'utiliser cette option.

Merci beaucoup!

[Invité]

Si votre tableau Données est "bourré" de formules, regardez le temps gagné en neutralisant le calcul automatique et en empêchant la mise à jour de l'écran dans votre programme actuel.
Le code ci-dessous permet également de calculer le temps de traitement.

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
 
Dim HeureDebut, HeureFin, TempsTotal
 
    HeureDebut = Timer
 
    With Application
         .ScreenUpdating = False
         .Calculation = xlCalculationManual
    End With
 
    ' Suite du programme
    ' ...
 
    With Application
         .ScreenUpdating = True
         .Calculation = xlCalculationAutomatic
    End With
 
    HeureFin = Timer
    TempsTotal = HeureFin - HeureDebut
    MsgBox "Temps total du traitement : " & Round(TempsTotal, 0) & " seconde(s)"

[Pascale B.]

Bonjour Eric,

Encore une fois merci d'avoir pris le temps, c'est très apprécié! Ma ma macro est maintenant beaucoup plus rapide!

Bonne journée!