Optimisation macro ?

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

J'ai réalisé une macro mais je pense qu'elle n'est pas optimisée car sont temps de traitement est extrèmement long.

Principe de la macro : pour chaque dossier, la macro parcours toute la liste et dit si c'est un dossier sans duplication, et le cas contraire, elle dit si c'est le dossier d'origine ou le dossier dupliqué. Dans ce dernier cas, la macro rappatrie, pour le dossier d'origine, la convention du dossier dupliqué. C'est le principe des recherchev imbriquées mais en VBA.

Pour 20 lignes ça va. Mais à 100 000 lignes ça met 5h.

N'y a-t-il pas un autre type de code me permettant de réduire ce temps de traitement ?

Merci par avance pour vos réponses.

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
69
70
Private Declare Function QueryPerformanceCounter Lib "Kernel32" (X As Currency) As Boolean
Private Declare Function QueryPerformanceFrequency Lib "Kernel32" (X As Currency) As Boolean
 
Sub detection_duplication()
Dim Debut As Currency, Fin As Currency, Freq As Currency
QueryPerformanceCounter Debut
 
Sheets(1).Shapes(1).Visible = False
Sheets(1).Shapes(2).Visible = True
 
i = 2
 
j = 2
 
Cells.Replace What:="=", Replacement:="", LookAt:=xlPart
 
'détermine la dernière ligne du fichier
While Range("A" & j) <> ""
    j = j + 1
Wend
 
fin_de_fichier = j
 
Range("G2:I" & fin_de_fichier).ClearContents
 
While Range("A" & i) <> ""
 
    'colonne numéro
    Range("G" & i) = Right(Range("B" & i), 10)
 
    'colonne origine dossiers
    If Range("G" & i) = "" Then
        Range("H" & i) = "dossier sans duplication"
    Else
        If Range("C" & i) = Range("G" & i) Then
            Range("H" & i) = "dossier origine"
        Else
            If Range("C" & i) <> Range("G" & i) And Range("G" & i) <> "" Then
                Range("H" & i) = "dossier dupliqué"
            End If
        End If
    End If
 
    'colonne dossier dupliqué
    j = i + 1
    If Range("B" & i) <> "" Then
        trouve = False
        valeur = Range("B" & i)
        While Range("A" & j) <> "" And trouve = False
            If Range("B" & j) = valeur Then
                Range("I" & i) = Range("D" & j)
                trouve = True
                j = j + 1
            Else
                j = j + 1
            End If
        Wend
    End If
 
    i = i + 1
 
Wend
 
Sheets(1).Shapes(1).Visible = True
Sheets(1).Shapes(2).Visible = False
 
QueryPerformanceCounter Fin
QueryPerformanceFrequency Freq
MsgBox "Durée de la procédure = " & Format(((Fin - Debut) / Freq), "0.00") & " s"
End Sub

09/01/2013, 17h18
Chips_
Je n'ai pas tout regardé en détail mais rien que remplacer ça
Code:

1 2 3 4 'détermine la dernière ligne du fichier While Range("A" & j) <> "" j = j + 1 Wend
par

Code:

j = Range("A65536").End(xlUp).Row

devrait améliorer un petit peu ta macro :)

Regarde aussi cette fonction

Code:

Application.ScreenUpdating = False
09/01/2013, 17h33
Philippe Tulliez
Bonjour,
Pour optimiser une procédure (macro), la première règle est de déclarer toutes les variables. Pour cela placer en tête de module Option Explicit
Certes avec le peu de variables que contient ta procédure tu ne vas sans doute pas constater de différence mais il est important de le faire.
Pour un balayage d'autant de lignes avec écriture sur les lignes, placer cette commande en début de procédure

Code:

Application.ScreenUpdating = False

là par contre la différence devrait se faire sentir.
S'il y a des formules, il y a aussi lieu de couper la calculation automatique par l'instruction

Code:

Application.Calculation = xlManual

sans oublier de remetre la calculation suivant l'option déterminée au préalable.
Donc lecture de cette option par

Code:

Dim optCalculation As Integer: optCalculation = Application.Calculation

Que l'on place en début de procédure et ainsi en fin de procédure on place cette ligne
Code:

1 2 Application.Calculation = optCalculation Application.ScreenUpdating = False
La deuxième ligne n'est pas obligatoire mais c'est plus propre.
Si tu veux passer à la vitesse turbo avec ta procédure, une façon idéale serait de travailler avec des variables tableaux.
Voir les tutoriels Les tableaux dans Excel 2007 et Conceptualisation des variables tableau en VBA et Application à l'optimisation du code sous Excel. Lecture indispensable si tu veux gérer de grands volume.
Il est préférable aussi de travailler avec des variables objets et préciser surtout sur quel range tu travailles parce-que Range("G2:I" & fin_de_fichier).ClearContents va effacer la feuille active. C'est à dire que tu risques d'effacer la feuille que tu as mis cinq heures à peaufiner tout simplement parce-que c'était la feuille active au moment où tu as enclencher la procédure.
10/01/2013, 08h49
lecter85

Bonjour,

Merci pour vos réponses !

J'avais déjà utilisé le Application.ScreenUpdating = False qui me fait gagner 30min tout au plus.
Je n'ai aucune formule de calcul sur mon fichier excel. A l'origine, ce fichier excel contenait des formules pour sortir le résultat escompté. Seulement, le temps de calcul était vraiment trop long et la plupart du temps Excel plantait. C'est pour cela que j'ai fait une macro.

Je vais voir du côté des variables tableaux pour passer en mode "turbo" comme le dit Philippe.

Et pour le j = Range("A65536").End(xlUp).Row merci ! J'avais appris ça il y a fort longtemps et tu viens de le déterrer !

Et si quelqu'un passe par là et voit autre chose je suis preneur :ccool: