Aide pour optimisation code VBA

Version imprimable

Bonjour,

j'ai un bout de code ' triage' qui effectue un clean de doublon en analysant ligne par ligne .

j'ai environ 300000 lignes a traité de façon quotidienne sauf que cette macro tourne environ pendant 16h .

Peux ton réduire ce temps selon vous ? et par quel moyen.

En vous remerciant.

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
71
72
73
74
 
Sub triage()
 
Dim cptc As Long
Dim cptx As Long
Dim x As Long
x = 2
y = 2
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks("national.xlsm").Worksheets("Feuil1").Activate
Cells(1, 1).Select
 
cptc = Cells.SpecialCells(xlCellTypeLastCell).Row
 
Range("a2:e" & cptc).Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("E2") _
        , Order2:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortTextAsNumbers, DataOption3 _
        :=xlSortNormal
 
 
Cells(1, 8).Value = "nb"
Cells(1, 7).Value = "tee"
Cells(1, 6).Value = "ETS"
 
 
While x < cptc
 
 
 
If Cells(x, 4) = "" Or Cells(x, 2) = "" Or Cells(x, 3) = "" Or Cells(x, 1) = "Commande de prélèvement" Then
    Cells(x, 1).EntireRow.Select
    Cells(x, 1).EntireRow.Delete
    x = x - 1
    cptc = cptc - 1
End If
     If Cells(x, 1) = Cells(x + 1, 1) Then
        Cells(x, 1).EntireRow.Select
        Cells(x, 1).EntireRow.Delete
        x = x - 1
        cptc = cptc - 1
 
    End If
x = x + 1
 
 
Wend
'Cells(x, 11).FormulaLocal = formule
''''''''''''''''''''''''''''''
ActiveWorkbook.Save
Cells(1, 1).Select
 
cptx = Cells.SpecialCells(xlCellTypeLastCell).Row
 
While y < cptx
formule = "=GAUCHE(DROITE(D" & y & ";5);3)"
formule2 = "=SI(NBCAR(D" & y & ")=7;GAUCHE(D" & y & ";1);GAUCHE(D" & y & ";2))"
Range("H" & y) = 1
Range("G" & y).FormulaLocal = formule
Range("F" & y).FormulaLocal = formule2
y = y + 1
Wend
Application.ScreenUpdating = True
 
ActiveWorkbook.Save
 
 
 
 
 
 
End Sub

27/11/2014, 12h20
vinc_bilb
Bonjour,

Oh oui, ça peut s'optimiser, avec un temps divisé entre 8 et 20 je pense! Par exemple ....
Code:

1 2 Cells(x, 1).EntireRow.Select Cells(x, 1).EntireRow.Delete
Ca c'est du terrible, répété.... Un bout d'exemple purgé de données confidentielles serait le bien-venu

Bonjour,
Déjà en supprimant tous les Select et Selection en les remplaçant par l'objet concerné
Petit exemple.
Au lieu de ces lignes de code
Code:

1 2 Cells(x, 1).EntireRow.Select Cells(x, 1).EntireRow.Delete
Cette ligne

Code:

Cells(x, 1).EntireRow.Delete

De plus tu parles de doublon or je ne vois rien dans ta procédure qui compare des lignes contenant les mêmes valeurs mais il est vrai que j'ai lu cette procédure rapidement.
Il existe une méthode pour supprimer les doublons depuis la version 2007. Voir avec l'enregistreur de macros en utilisant l'outil Supprimer les doublons du groupe Outils de données de l'onglet [Données]
Une autre solution est de préparer une formule (Formule avec OU ou ET) qui compare tous les cas des lignes devant être supprimées. Cette formule renverra par exemple VRAI si la ligne doit être supprimée et ensuite faire un filtre sur les valeurs VRAI et supprimer les lignes filtrées.
A mon avis 10 secondes maximum pour l'exécution.

[EDIT]
J'ajouterais qu'au lieu de faire une boucle pour entrer des formules à chaque ligne (30000 d'après tes dires)
Code:

1 2 3 4 5 6 7 8 While y < cptx formule = "=GAUCHE(DROITE(D" & y & ";5);3)" formule2 = "=SI(NBCAR(D" & y & ")=7;GAUCHE(D" & y & ";1);GAUCHE(D" & y & ";2))" Range("H" & y) = 1 Range("G" & y).FormulaLocal = formule Range("F" & y).FormulaLocal = formule2 y = y + 1 Wend
Il suffit d'écrire
Code:

1 2 3 Range("H2:H" & cptx) = 1 Range("G2:G" & cptx).FormulaLocal = "=GAUCHE(DROITE(D2;5);3)" Range("F2:F" & cptx).FormulaLocal = "=SI(NBCAR(D2)=7;GAUCHE(D2;1);GAUCHE(D2;2))"
Personnellement, je ne suis pas partisan d'utiliser la propriété FormulaLocal et de plus il est prudent de préciser la filiation complète de la cellule (sa feuille et son classeur.

27/11/2014, 13h56
adelas93

merci pour toute les pistes j'attends la fin de la macro pour tester vos soluces.

je rajouterai aussi

Application.Calculation = xlCalculationManual en debut
Application.Calculation = xlCalculationAutomatic en fin.

ma boucle de delete doublon c'est mon deuxième if c'est sur c'est pas terrible mais sur le moment c'est ce qui était le plus simple .

EDIT:

les modif semble très bien fonctionner sur mon fichier de test. en fait j utilise le select pour le debug histoire de voir si je suis bien sur la bonne ligne (Ici le gap est énorme)

je vais mettre cela en prod ce soir je vous fait un retour demain record à battre 15h37 min

je vous remercie car le résultat est simplement extraordinaire je suis maintenant sur un temp global de 5h je peux mettre à dispo de mes datas dès le matin .

encore merci