Discussion :

[novicenovice]

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

[Guidhy]

Bon je suis aussi novice mais bon on sait jamais....

J'ai vu que pour chacun, tu fais :

Code :

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

1
2
3
4
5
6
7
Set RST_DATA_TMP = New ADODB.Recordset
Set RNGTMP = Range(STTMP)
Set Conn = New ADODB.Connection
Set CMD = New ADODB.Command
Set RST = New ADODB.Recordset
Set RGLISTE = Range(STLISTE)
Set RGLIB = Range(STLIB)

puis ensuite :

Code :

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

1
2
3
4
5
6
7
Set RST_DATA_TMP = Nothing
Set RNGTMP = Nothing
Set Conn = Nothing
Set CMD = Nothing
Set RST = Nothing
Set RGLISTE = Nothing
Set RGLIB = Nothing

Mais pas pour :

Code :

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

Set RSTADO = RST.Clone

y'a pas besoin de :

Code :

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

Set RSTADO = Nothing

???


Je ne sais pas si c'est ça.... car je ne maitrise pas du tout..... c'est juste un constat visuel des procedures.... (Je sais juste qu'on m'avait dit un trux dans le genre un jour...)

[Pierre Fauconnier]

Bonjour

Je n'ai pas lu tout ton code, mais voici peut-être une piste, en passant en mode de calcul manuel en début de procédure et en remettant le mode de calcu initial en fin de procédure

En début de procédure, mets

Code :

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

1
2
3
4
5
6
7
    Dim TypeCalculation As XlCalculation
 
    TypeCalculation = Application.Calculation
    Application.Calculation = xlCalculationManual
    ...
    ...
    Application.Calculation = TypeCalculation

[novicenovice]

A vrai dire j'ai déjà intégrer sur un cmd le traitement du calcul mais çà ne change rien.



Je remarque que l'utilisation du processeur est très important au moment de la réexécution (99% pendant plusieurs minutes)

[dam2p]

J'ai déjà remarqué que l'exécution d'une requête SQL sous Excel charge terriblement la mémoire haute, et ça m'a planté une application qui tournait avant avec moins de données : j'ai vu d'un seul coup l'occupation mémoire pour le process Excel passer de 40Mo à 180Mo en moins de 10 secondes. S'en est suivie une erreur générale Excel, et un mal fou à tuer le processus.

Ton utilisation des instruction SQL ne m'est pas familière (pour ma part, je lance l'exécution de la requête par la méthode .refresh), mais il y a fort à parier que le résultat soit le même. Et grâce à toi j'ai testé qqchose de nouveau qui marche !!! . Cf. mon bout de code sur une autre requête que celle qui monte à 180Mo. Le résultat est constitué dans la feuille "Relation".

Avant, la charge mémoire du processus Excel passe de 53252 ko à 59152ko sur l'instruction .refresh.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
    l_s_Requete2 = l_s_Requete2 & " ORDER BY left(Z_PM.`Source&Nat`,4),Z_PM.Mnémonique " 'fin de l'initialisation de la rquête
 
    l_s_Nombase = g_s_dossierTemp & "TM_PARAM.xls"
    l_s_temp = ExtraitChemin(g_s_dossierTemp)
    l_s_Connect = "ODBC;DSN=Excel Files;DBQ=" & l_s_Nombase & ";DefaultDir=" & l_s_temp & ";DriverId=22;MaxBufferSize=2048;PageTimeout=5;"
 
    '-- Exécution de la  requête  Paquet TM et Point Mesure
    With g_o_PWS("Relation").QueryTables.Add(Connection:=l_s_Connect, _
            Destination:=g_o_PWS("Relation").Range("A1"), Sql:=l_s_Requete2)
        .FieldNames = True
        .Refresh BackgroundQuery:=False
    End With

Après correction, la charge mémoire du processus Excel passe de 53156 ko à 53168ko!!!

Code :

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

1
2
3
4
5
6
7
8
    '-- Exécution de la  requête  Paquet TM et Point Mesure
    With g_o_PWS("Relation").QueryTables.Add(Connection:=l_s_Connect, _
            Destination:=g_o_PWS("Relation").Range("A1"), Sql:=l_s_Requete2)
        .FieldNames = True
        .SaveData = False            'instruction rajoutée Dam2P
        .BackgroundQuery = False  'instruction rajoutée Dam2P
        .Refresh BackgroundQuery:=False
    End With

j'espère que ça t'aidera !!!
A+
Dam2P