Discussion :

[Orhleil]

Bonjour à tous,
Je réalise une macro qui traite des données provenant d'un autre fichier Excel (et à terme d'un troisième fichier...). Ledit autre fichier contient environ 27000 lignes de données. Mon traitement fonctionne bien, mais la macro actuelle (qui est amenée à se complexifier un peu) met déjà près de 1h30 à s'exécuter... Je vous mets juste après le code de la macro en question, dans les (...) des bouts de codes sans importance sur la durée d'exécution, et je vous joins aussi le code de macros auxquelles je fais appel.
Si quelqu'un a une vague idée de ce qui fait ramer à ce point, je suis preneur... Merci d'avance.
Le ScreenUpdating est désactivé, ainsi que le calculation, idem pour les Events et même l'écran de veille (bah oui, en 1h30 l'écran de veille se déclenche...)

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
Private Sub MajDonnees()
    '(...)
    ActiveScreenSaver False
    'Ouverture du fichier ExtractionDPN.xls
    On Error GoTo TraitementOuvFich
    Dim ClasseurDPN As Workbook
    Set ClasseurDPN = Workbooks.Open("C:\Users\Moi\Desktop\ExtractionDPN.xls", , True)
    ClasseurDPN.Windows(1).Visible = False
    GoTo OuvFichOk
TraitementOuvFich:
    MsgBox ("L'application n'a pas pu ouvrir le fichier ExtractionDPN.xls, vérifiez que le fichier est bien dans le même dossier que l'application.")
    Err.Clear
    GoTo Suite
OuvFichOk:
    ClasseurDPN.Saved = True
    'Traitement des données DPN
    On Error GoTo 0
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim ListeCommandesDPN As Range
    Set ListeCommandesDPN = ClasseurDPN.Worksheets("Feuil1").Range(ClasseurDPN.Worksheets("Feuil1").Cells(65, gpNumCommande), ClasseurDPN.Worksheets("Feuil1").Cells(65, gpNumCommande), End(xlDown))
    NbCommandes = ListeCommandesDPN.Rows.Count
    For Each NumCommande In ListeCommandesDPN
        'Processus d'ajout des commandes non existantes
        If NumCommande.Formula = NumCommande.Offset(-1, 0).Formula Then GoTo FinAjoutDPN 'Pour accélérer un peu la recherche des nouvelles commandes
        If Not CommandeExiste(NumCommande.Formula) Then
            AjouterCommande (NumCommande.Formula)
        End If
FinAjoutDPN:
        'COLONNES AUTOMATISEES
        Dim LigneContrats As Variant
        LigneContrats = Intersect(Contrats.Rows(IndexLigne(NumCommande.Formula, Contrats, AutoCont_NumCommande)), Contrats.UsedRange)
        Dim LigneSurveillance As Variant
        LigneSurveillance = Intersect(Surveillance.Rows(IndexLigne(NumCommande.Formula, Surveillance, AutoSurv_NumCommande)), Surveillance.UsedRange)
        Dim LigneExtract As Variant
        LigneExtract = Intersect(ClasseurDPN.Worksheets("Feuil1").Rows(NumCommande.Row), ClasseurDPN.Worksheets("Feuil1").UsedRange)
        'TODO : On Error Resume Next => On garde toutes les automatisations mais ne s'effectuent que celles des colonnes présentes
        On Error GoTo ErreurAuto
        CCSContrats LigneContrats, LigneExtract 'CONTRATS : CCS
        NumContratContrats LigneContrats, LigneExtract 'CONTRATS : N° du marché
        NumContratSurveillance LigneSurveillance, LigneExtract 'SURVEILLANCE : N° du marché
        IntituleContratContrats LigneContrats, LigneExtract 'CONTRATS : Intitulé
        TitulaireContrats LigneContrats, LigneExtract 'CONTRATS : Titulaire
        PrestataireSurveillance LigneSurveillance, LigneExtract 'SURVEILLANCE : Prestataire
        DateDebutContrats LigneContrats, LigneExtract 'CONTRATS : Date de début
        EtatTrancheContrats LigneContrats, LigneSurveillance 'SURVEILLANCE : État et tranche
        DPNDINSurveillance LigneSurveillance, True 'SURVEILLANCE : DPN/DIN
        ServiceContrats LigneContrats, LigneExtract 'CONTRATS : Service
        ServiceSurveillance LigneSurveillance, LigneExtract 'SURVEILLANCE : Prestataire
        GoTo SuiteCommandeDPN
ErreurAuto:
        MsgBox ("Le processus d'entrée automatique des données pour la commande " & NumCommande.Formula & " a dû être arrêté pour la raison suivante :" & vbNewLine & """" & Err.Description & """")
        Err.Clear
        Resume SuiteCommandeDPN
SuiteCommandeDPN:
        '(...)
    Next NumCommande
    'Fermeture du fichier ExtractionDPN.xls
    On Error GoTo TraitementFerFichDPN
    ClasseurDPN.Close
    GoTo Suite
TraitementFerFichDPN:
    MsgBox ("L'application n'a pas pu fermer correctement le fichier ExtractionDPN.xls en raison d'une erreur inconnue.")
    Err.Clear
Suite:
    '(...)
    'On réactive l'écran de veille
    ActiveScreenSaver True
End Sub

Il est bon de préciser que ma macro rentre très rarement dans "AjouterCommande".
Contrats et Surveillance sont les noms de deux Worksheets.
Dans la partie COLONNES AUTOMATISEES, toutes les macros sont de la forme suivante :

Code :

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

1
2
3
Public Sub DPNDINSurveillance(LigneSurveillance As Variant, DPN As Boolean)
    If DPN Then LigneSurveillance(1, AutoSurv_DPNDIN) = "DPN" Else LigneSurveillance(1, AutoSurv_DPNDIN) = "DIN"
End Sub

A part une ou deux, mais qui n'expliquent pas un énorme décalage de durée.
Si je commente toute la partie COLONNES AUTOMATISEES, je diminue environ de moitié le temps d'exécution. Ce qui fait quand même pas loin de 45 minutes pour un pauvre parcours d'une colonne au final...

J'espère que quelqu'un saura m'indiquer comment accélérer un peu (beaucoup...?) cette macro...
Je tourne sous Excel 2007, avec Windows Vista.

Merci par avance !

EDIT : j'avais oublié la macro CommandeExiste, qui elle est répétée quasiment à chaque fois :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Public Function CommandeExiste(Numero As String) As Boolean
    On Error GoTo Fin
    CommandeExiste = False
    Dim ZoneRecherche As Range
    Set ZoneRecherche = Intersect(Contrats.Columns(IndexColonne("N° de commande", Contrats, 1)), Contrats.UsedRange)
    Dim Valeur As Double
    Valeur = CDbl(Numero)
    Dim Trouve As Double
    Trouve = Application.WorksheetFunction.Match(Valeur, ZoneRecherche, 0)
    If 0 < Trouve Then CommandeExiste = True
Fin:
    Err.Clear
End Function