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!