Pour ceux qui peuvent m'aider !

J'ai crée un programe qui permet de synthetiser plusieurs plages en une seule.

Lorsque que je le lance pour la première fois, le résultat est restitué en quelques secondes (-10s). Mais pour les autres exécution le programmes prend plusieurs minutes.

J'ai en effet remarqué que l'utilisation de la mémoire physique est avant l'exécution du code à environ 20 Méga et après excel utilise environ 50 Méga.

Toutes mes variables ont bien été close et nothing à la fin de l'instruction mais çà ne change rien.

Avez vous une idée pour résoudre ce problème?

En vous remerciant par avance.

Main 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
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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
Sub TRAITEMENT()
 
Dim STFILE As String, STSQL As String, STZONE_ANALYSE() As String
Dim RNGTMP As Range
Dim RST_DATA_TMP As ADODB.Recordset
 
Dim STCODE_USINE As String, STCODE_OPCO As String, STCODE_SITE As String, STCODE_FDV As String
Dim STCODE_CORGP As String, TLIB_CORGP As String, STTRANSIT As String, STCODE_PERIODE As String
 
Dim STLIST As String, STLIB As String
Set RST_DATA_TMP = New ADODB.Recordset
 
'CHARGEMENT DES ZONES D'ANALYSE
 
    STFILE = ActiveWorkbook.FullName
 
    STZONE_ANALYSE() = Split(TRAITEMENT_ZONELISTE("T_ANALYSIS", STFILE), ";")
 
    STLIST = "T_LISTDATA"
    STLIB = "LIB"
 
    NETTOYAGEZONES STLIST, STLIB
 
    For U = 0 To UBound(STZONE_ANALYSE)
 
        STSQL = TRAITEMENT_CODE_SQL(STZONE_ANALYSE(U))
 
        Set RST_DATA_TMP = RSTADO(STSQL, STFILE)
 
        If RST_DATA_TMP.RecordCount <> 0 Then
 
            'A) Recupérere les données dans base TMP
 
                STLIST = "T_LISTDATA_TMP"
                STLIB = "LIB_TMP"
                STTMP = "DATA_LISTDATA_TMP"
 
                NETTOYAGEZONES STLIST, STLIB
 
                Set RNGTMP = Range(STTMP)
 
                RNGTMP.CopyFromRecordset RST_DATA_TMP
 
                RST_DATA_TMP.Close
 
            'B) Fusionner les données (TMP et liste) dans base TMP 2
 
                STSQL = "SELECT * FROM [T_LISTDATA] WHERE [TO] IS NOT NULL UNION ALL SELECT * FROM [T_LISTDATA_TMP]"
 
                Set RST_DATA_TMP = RSTADO(STSQL, STFILE)
 
                STLIST = "T_LISTDATA_2TMP"
                STLIB = "LIB_2TMP"
                STTMP = "DATA_LISTDATA_2TMP"
 
                NETTOYAGEZONES STLIST, STLIB
 
                Set RNGTMP = Range(STTMP)
 
                RNGTMP.CopyFromRecordset RST_DATA_TMP
 
                RST_DATA_TMP.Close
 
            'C) Coller la base tmp2 dans liste
 
                STSQL = "SELECT [CODE_USINE],[CODE_OPCO],[CODE_SITE],[CODE_FDV],[CODE_CORGP],[LIB_CORGP],[TRANSIT],[CODE_SAISON],round(cdbl([TO]),2) as [Val]"
 
                STSQL = STSQL & " FROM [T_LISTDATA_2TMP]"
 
                Set RST_DATA_TMP = RSTADO(STSQL, STFILE)
 
                STLIST = "T_LISTDATA"
                STLIB = "LIB"
                STTMP = "DATA_LISTDATA"
 
                NETTOYAGEZONES STLIST, STLIB
 
                Set RNGTMP = Range(STTMP)
 
                RNGTMP.CopyFromRecordset RST_DATA_TMP
 
                STLIST = "T_LISTDATA_TMP"
                STLIB = "LIB_TMP"
 
                NETTOYAGEZONES STLIST, STLIB
 
                STLIST = "T_LISTDATA_2TMP"
                STLIB = "LIB_2TMP"
 
                NETTOYAGEZONES STLIST, STLIB
 
                Set RNGTMP = Nothing
 
        End If
 
 Next U
 
STSQL = "SELECT * FROM [T_LISTDATA]"
 
Set RST_DATA_TMP = RSTADO(STSQL, STFILE)
 
'AFFECTATION DES CODES DE TRANSIT
 
While Not RST_DATA_TMP.EOF = True
 
    With RST_DATA_TMP
 
        STCODE_USINE = NZT(.Fields("CODE_USINE").Value, "_")
        STCODE_SITE = NZT(.Fields("CODE_SITE").Value, "_")
 
    End With
 
    If STCODE_USINE = STCODE_SITE Then
 
        STTRANSIT = "NT"
 
    Else
 
        STTRANSIT = "TR"
 
    End If
 
    With RST_DATA_TMP
 
        .Fields("TRANSIT").Value = STTRANSIT
        .Update
 
    End With
 
    RST_DATA_TMP.MoveNext
 
Wend
 
RST_DATA_TMP.Close
Set RST_DATA_TMP = Nothing
 
End Sub
FONCTION CHARGEMENT RECORDSET
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
Function RSTADO(ByVal STSQL As String, ByVal STFILE As String) As Recordset
 
Dim Conn As ADODB.Connection
Dim CMD As ADODB.Command
Dim RST As ADODB.Recordset
 
Set Conn = New ADODB.Connection
Set CMD = New ADODB.Command
Set RST = New ADODB.Recordset
 
With Conn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Data Source=" & STFILE & ";Extended Properties=Excel 8.0;"
    .Open
 
End With
 
With RST
    .ActiveConnection = Conn
    .Open STSQL, Conn, adOpenStatic, adLockOptimistic
End With
 
Set RSTADO = RST.Clone
 
 
Set Conn = Nothing
Set CMD = Nothing
Set RST = Nothing
 
 
End Function
Fonction Vidage des zones de listes (tampon et autres)
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
Function NETTOYAGEZONES(STLISTE As String, STLIB As String)
 
Dim RGLISTE As Range
Dim RGLIB As Range
 
Set RGLISTE = Range(STLISTE)
Set RGLIB = Range(STLIB)
 
If RGLISTE.Rows.Count > 2 Then
 
    RGLISTE.ListObject.Resize RGLIB.Resize(2, RGLIB.Columns.Count)
    Range(RGLIB.Offset(3, 0), RGLIB.Offset(3, 0).End(xlDown)).EntireRow.Delete
 
End If
 
 
If RGLISTE.ListObject.ListRows.Count <> 0 Then
 
     RGLISTE.ListObject.ListRows(1).Delete
 
End If
 
 
Set RGLISTE = Nothing
Set RGLIB = Nothing
End Function