Discussion :

[lecter85]

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 :

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