Temps de Traitement trop long

**RGShoop** · 21/06/2007, 15h34

Bonjour à tous,

J'effectue un import de fichier puis je retraite les lignes importées pour dispatcher leur contenu dans différentes tables.

L'importation et le dispatche des données fonctionnent très bien mais le temps de traitement est vraiment trop long.

Qui aurait une idée pour optimiser les boucles ???

Merci d'avance,

RGShoop

Invité · 21/06/2007, 15h35

Bonjour

Heu, à travers l'écran je vois ton code.

On fait comment pour deviner ton code ?

Starec

**RGShoop** · 21/06/2007, 15h41

Je voulais juste avoir quelques conseils pour optimiser les boucles mais si tu veux voir mon code, pas de problème

Merci

RGshoop

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
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
Sub TraitementCT(Barre As Control)
 
    Dim Dbs As DAO.Database
    Dim RsTmp As DAO.Recordset
    Dim RsCT As DAO.Recordset
    Dim RsSplit As DAO.Recordset
    Dim boolMAJ As Boolean
    Dim CompteCreer As Integer
    Dim CompteMAJ As Integer
    Dim Crit1, LignePrecedente As String
 
    Set Dbs = CurrentDb
    Set RsTmp = Dbs.OpenRecordset("Qry_InformationTech_Source", dbOpenDynaset)
    Set RsCT = Dbs.OpenRecordset("Tbl_Import_Tech_Information", dbOpenDynaset)
    Set RsSplit = Dbs.OpenRecordset("Tbl_Import_Tech_Split", dbOpenDynaset)
 
    CompteCreer = 0
    CompteMAJ = 0
    RsTmp.MoveLast
    Debug.Print RsTmp.RecordCount
    Barre.Min = 0
    Barre.Max = RsTmp.RecordCount
    RsTmp.MoveFirst
 
 
    Do Until RsTmp.EOF
            Barre.Max = RsTmp.RecordCount
        If IsNull(RsTmp!FAC) = True Then GoTo ChangementEnregistrement
 
        Crit1 = "[keymatch]=" & Chr(34) & RsTmp!FAC & RsTmp!Exercice & RsTmp!N°Ordre & Chr(34)
 
        If LignePrecedente = Crit1 Then
        GoTo ChangementEnregistrement
        End If
 
            RsCT.FindFirst Crit1
 
            If RsCT.NoMatch = True Then ' S'il s'agit d'une nouvelle FAC ,exercice et N Ordre ajoute une nouvel enregistrement
 
            With RsCT
                CompteCreer = CompteCreer + 1
                .AddNew
                !keymatch = RsTmp!FAC & RsTmp!Exercice & RsTmp!N°Ordre
                !FAC = RsTmp!FAC
                !Exercice = RsTmp!Exercice
                !N°Ordre = RsTmp!N°Ordre
                ![Inception Date] = RsTmp!EFFET
                ![Expiry Date] = RsTmp!ECHEANCE
                ![Insured Name] = RsTmp!ASSURE_PRINCIPAL
                ![Sum Insured] = IIf(IsNull(RsTmp![Sommes assurées (global)]), 0, RsTmp![Sommes assurées (global)])
                !Devise = RsTmp!Devise
                ![EGPI Amount] = RsTmp!DIVISION_ALIMENT
                !MultiDivision = MultiDivision(RsTmp!FAC, RsTmp!Exercice, RsTmp!N°Ordre)
                !N°Cédante = RsTmp!N°CEDANTE
                !sNomCedante = RsTmp!CEDANTE
                !sNomCourtier = RsTmp!INTERMEDIAIRE
                !Lob = RsTmp![DIV LOB LIBELLE]
                !VentilationComptable = IIf(RsTmp![Ventilation division OK] = "Y", -1, 0)
                !DateCreation = Format(Now, "dd/mm/yyyy")
                !UserMAJ = "Data Admin"
                !Contengency = RsTmp!Flag_Contingency
                If RsTmp!N°CEDANTE = "12155" Then
                !Direct = -1
                Else
                !Reass = -1
                End If
                .Update
            End With
 
            Else 'Sinon  verifie que les éléments n'ont pas été modifiés sinon les mets à jour et inscrit la date de modification
 
                boolMAJ = False
 
            With RsCT
                If ![Inception Date] <> RsTmp!EFFET Then
                .Edit
                ![Inception Date] = RsTmp!EFFET
                !DateDerniereMAJ = Format(Now, "dd/mm/yyyy")
                !UserMAJ = "Data Admin modified"
                .Update
                boolMAJ = True
                End If
                If ![Expiry Date] <> RsTmp!ECHEANCE Then
                .Edit
                ![Expiry Date] = RsTmp!ECHEANCE
                !DateDerniereMAJ = Format(Now, "dd/mm/yyyy")
                !UserMAJ = "Data Admin modified"
                .Update
                boolMAJ = True
                End If
                If ![Insured Name] <> RsTmp!ASSURE_PRINCIPAL Then
                .Edit
                ![Insured Name] = RsTmp!ASSURE_PRINCIPAL
                !DateDerniereMAJ = Format(Now, "dd/mm/yyyy")
                !UserMAJ = "Data Admin modified"
                .Update
                boolMAJ = True
                End If
'                Debug.Print CDbl(![Sum Insured]) & CDbl(RsTmp![Sommes assurées (global)])
'                If ![Sum Insured] <> (RsTmp![Sommes assurées (global)]) Then
'                .Edit
'                ![Sum Insured] = RsTmp![Sommes assurées (global)]
'                !DateDerniereMAJ = Format(Now, "dd/mm/yyyy")
'                !UserMAJ = "Data Admin modified"
'                .Update
'                boolMAJ = True
'                End If
                If !Devise <> RsTmp!Devise Then
                .Edit
                !Devise = RsTmp!Devise
                !DateDerniereMAJ = Format(Now, "dd/mm/yyyy")
                !UserMAJ = "Data Admin modified"
                .Update
                boolMAJ = True
                End If
                If CDbl(![EGPI Amount]) <> CDbl(RsTmp!DIVISION_ALIMENT) Then
                .Edit
                ![EGPI Amount] = RsTmp!DIVISION_ALIMENT
                !DateDerniereMAJ = Format(Now, "dd/mm/yyyy")
                !UserMAJ = "Data Admin modified"
                .Update
                boolMAJ = True
                End If
                If !MultiDivision <> MultiDivision(RsTmp!FAC, RsTmp!Exercice, RsTmp!N°Ordre) Then
                .Edit
                !MultiDivision = MultiDivision(RsTmp!FAC, RsTmp!Exercice, RsTmp!N°Ordre)
                !DateDerniereMAJ = Format(Now, "dd/mm/yyyy")
                !UserMAJ = "Data Admin modified"
                .Update
                boolMAJ = True
                End If
                 If !N°Cédante <> RsTmp!N°CEDANTE Then
                .Edit
                 !N°Cédante = RsTmp!N°CEDANTE
                !DateDerniereMAJ = Format(Now, "dd/mm/yyyy")
                !UserMAJ = "Data Admin modified"
                .Update
                boolMAJ = True
                End If
                If !sNomCourtier <> RsTmp!INTERMEDIAIRE Then
                .Edit
                 !sNomCourtier = RsTmp!INTERMEDIAIRE
                !DateDerniereMAJ = Format(Now, "dd/mm/yyyy")
                !UserMAJ = "Data Admin modified"
                .Update
                boolMAJ = True
                End If
                If !Lob <> RsTmp![DIV LOB LIBELLE] Then
                .Edit
                 !Lob = RsTmp![DIV LOB LIBELLE]
                !DateDerniereMAJ = Format(Now, "dd/mm/yyyy")
                !UserMAJ = "Data Admin modified"
                .Update
                boolMAJ = True
                End If
                Debug.Print !VentilationComptable & " " & IIf(RsTmp![Ventilation division OK] = "Y", True, False)
                If !VentilationComptable <> IIf(RsTmp![Ventilation division OK] = "Y", True, False) Then
                .Edit
                !VentilationComptable = IIf(RsTmp![Ventilation division OK] = "Y", True, False)
                !DateDerniereMAJ = Format(Now, "dd/mm/yyyy")
                !UserMAJ = "Data Admin modified"
                .Update
                boolMAJ = True
                End If
 
                If !Contengency <> RsTmp!Flag_Contingency Then
                .Edit
                !Contengency = RsTmp!Flag_Contingency
                !DateDerniereMAJ = Format(Now, "dd/mm/yyyy")
                !UserMAJ = "Data Admin modified"
                .Update
                boolMAJ = True
                End If
            End With
            End If
                If boolMAJ = True Then
                CompteMAJ = CompteMAJ + 1
                RsCT.Edit
                RsCT!blValidation = False
                RsCT.Update
                End If
        LignePrecedente = Crit1
 
ChangementEnregistrement:
        RsTmp.MoveNext
    Loop
 
    MsgBox "- Nombre de Fac créées : " & CompteCreer & vbCrLf & "- Nombre de Fac modifiées : " & CompteMAJ
 
ExitSub:
    RsTmp.Close
    RsCT.Close
    RsSplit.Close
    Set Dbs = Nothing
 
End Sub
 
Function MultiDivision(oFAC As String, oEXERCICE As String, oORDER As String) As Boolean
 
Dim DB As DAO.Database
Dim rs As Recordset
Dim i As Integer
Dim PremiereDivision As String
Dim DeuxiemeDivision As String
 
Set DB = CurrentDb
Set rs = DB.OpenRecordset("SELECT * FROM Tbl_Import_Tech_Information_TMP " & _
"WHERE (((Tbl_Import_Tech_Information_TMP.FAC)=" & Chr(34) & oFAC & Chr(34) & ") " & _
"AND ((Tbl_Import_Tech_Information_TMP.EXERCICE)=" & Chr(34) & oEXERCICE & Chr(34) & ") " & _
"AND ((Tbl_Import_Tech_Information_TMP.N°ORDRE)=" & Chr(34) & oORDER & Chr(34) & "))" & _
"ORDER BY Tbl_Import_Tech_Information_TMP.FAC, Tbl_Import_Tech_Information_TMP.EXERCICE, Tbl_Import_Tech_Information_TMP.N°ORDRE;", dbOpenDynaset)
 
rs.MoveFirst
PremiereDivision = rs![Division]
DeuxiemeDivision = rs![Division]
MultiDivision = False
Debug.Print rs.RecordCount
 
Do Until rs.EOF
 
    DeuxiemeDivision = rs![Division]
 
    If PremiereDivision <> DeuxiemeDivision Then
    MultiDivision = True
    Exit Do
    Else
    MultiDivision = False
    End If
    rs.MoveNext
 
Loop
 
rs.Close
Set DB = Nothing
 
End Function
 
Function SplitCT(Barre As Control)
 
Dim DB As DAO.Database
Dim rs As DAO.Recordset
Dim RsSplit As DAO.Recordset
Dim RsTmp As DAO.Recordset
Dim i As Integer
Dim jint As Integer
Dim Crit As String
Dim CritSplit As String
Dim blMAJ As Boolean
    Barre.Min = 0
 
Set DB = CurrentDb
Set rs = DB.OpenRecordset("Tbl_Import_Tech_Information", dbOpenDynaset)
Set RsSplit = DB.OpenRecordset("Tbl_Import_Tech_Split", dbOpenDynaset)
Set RsTmp = DB.OpenRecordset("Tbl_Import_Tech_Information_TMP", dbOpenDynaset)
 
If rs.RecordCount = 0 Then Exit Function
 
rs.MoveLast
    Barre.Max = rs.RecordCount
rs.MoveFirst
 
jint = 1
Do Until rs.EOF
    Crit = "[FAC]=" & Chr(34) & rs!FAC & Chr(34) & " AND [EXERCICE]=" & Chr(34) & rs!Exercice & Chr(34) & " AND [N°ORDRE]=" & Chr(34) & rs!N°Ordre & Chr(34)
            Debug.Print jint & ":" & rs.RecordCount
        RsTmp.FindFirst Crit
 
        i = 1
            Do Until RsTmp.NoMatch = True
 
            CritSplit = "[CleRecherche]=" & Chr(34) & rs!ID_ImportationTechnique & "-" & RsTmp!Division & "-" & i & "-" & RsTmp!Pays & "-" & RsTmp![Pays lib] & "-" & CInt(RsTmp![Aliment %]) & "-" & InfoPays(RsTmp!Pays, "TauxTaxe") & Chr(34)
 
            Debug.Print "WHERE " & CritSplit & ";"
 
 
                RsSplit.FindFirst CritSplit
                If RsSplit.NoMatch = True Then
                With RsSplit
 
                        .AddNew
                                !ID_ImportationTechnique = rs!ID_ImportationTechnique
                                !Division = RsTmp!Division
                                !Ligne = i
                                !CodeCountry = RsTmp![Pays]
                                !Country = RsTmp![Pays lib]
                                ![EGPI_%] = FormatNumber(IIf(IsNull(RsTmp![Aliment %]) = False, RsTmp![Aliment %], IIf(CompteDeSplit(Crit) = 1, 100, 0)), 2)
                                !TaxRate = InfoPays(RsTmp!Pays, "TauxTaxe")
                                !Terrorism = InfoPays(RsTmp!Pays, "Terrorism")
                                !keymatch = RsTmp!FAC & RsTmp!Exercice & RsTmp![N°Ordre]
                                !CleRecherche = rs!ID_ImportationTechnique & "-" & RsTmp!Division & "-" & i & "-" & RsTmp!Pays & "-" & RsTmp![Pays lib] & "-" & CInt(RsTmp![Aliment %]) & "-" & InfoPays(RsTmp!Pays, "TauxTaxe")
                        .Update
 
                End With
                Else
                       With RsSplit
                                .Edit
                                !Division = RsTmp!Division
                                !Ligne = i
                                !CodeCountry = RsTmp![Pays]
                                !Country = RsTmp![Pays lib]
                                ![EGPI_%] = FormatNumber(IIf(IsNull(RsTmp![Aliment %]) = False, RsTmp![Aliment %], IIf(CompteDeSplit(Crit) = 1, 100, 0)), 2)
                                !TaxRate = InfoPays(RsTmp!Pays, "TauxTaxe")
                                !Terrorism = InfoPays(RsTmp!Pays, "Terrorism")
                                !keymatch = RsTmp!FAC & RsTmp!Exercice & RsTmp![N°Ordre]
                                .Update
                End With
                End If
 
            i = i + 1
            RsTmp.FindNext Crit
            Loop
 
            'Procédure de vérification du montant total des répartitions
 
If DSum("[EGPI_%]", "Tbl_Import_Tech_Split", "[ID_ImportationTechnique]=" & rs!ID_ImportationTechnique) = 100 Then 'Somme du Split différent de 100% de l'EGPI
        rs.Edit
        'rs!blValidation = True
        rs!UserMAJ = "Data Admin"
        rs.Update
 
ElseIf DSum("[EGPI_%]", "Tbl_Import_Tech_Split", "[ID_ImportationTechnique]=" & rs!ID_ImportationTechnique) <> 100 Then 'Somme du Split différent de 100% de l'EGPI
        If DSum("[EGPI_%]", "Tbl_Import_Tech_Split", "[ID_ImportationTechnique]=" & rs!ID_ImportationTechnique) < 100 Then 'Somme Split plus petit que 100% de l'EGPI
                If DSum("[EGPI_%]", "Tbl_Import_Tech_Split", "[ID_ImportationTechnique]=" & rs!ID_ImportationTechnique) <> 0 Then
                    With RsSplit
                                .AddNew
                                !ID_ImportationTechnique = rs!ID_ImportationTechnique
                                !Division = RsTmp!Division
                                !Ligne = i
                                !CodeCountry = "999"
                                !Country = "World Wide"
                                ![EGPI_%] = 100 - DSum("[EGPI_%]", "Tbl_Import_Tech_Split", "[ID_ImportationTechnique]=" & rs!ID_ImportationTechnique)
                                !TaxRate = InfoPays("999", "TauxTaxe")
                                !Terrorism = InfoPays("999", "Terrorism")
                                !keymatch = RsTmp!FAC & RsTmp!Exercice & RsTmp![N°Ordre]
                        .Update
                    rs.Edit
                    rs!blValidation = False
                    rs.Update
                    End With
                End If
        ElseIf DSum("[EGPI_%]", "Tbl_Import_Tech_Split", "[ID_ImportationTechnique]=" & rs!ID_ImportationTechnique) > 100 Then 'Somme Split plus grand que 100% de l'EGPI
 
        rs.Edit
        rs!blValidation = False
        rs!UserMAJ = "Data Admin"
        rs.Update
        End If
 
End If
 
            jint = jint + 1
rs.MoveNext
Loop
 
RsSplit.Close
RsTmp.Close
rs.Close
Set DB = Nothing
 
End Function

Temps de Traitement trop long

VBA Access

Discussions similaires

Partager

Partager