Optimisation Macro VBA - RecordSet
Bonjour à tous,
Et merci du temps que vous allez m'accorder !
Je débute un peu en VBA, j'ai la macro ci-dessous qui semble fonctionner, mais j'ai de problèmes de perf ... Après l'avoir laissé tourné pendant 9h, avec un access qui ne répond pas, j'ai du faire un fin de tâche, et à l'ouverture j'avais environ la moitié des enregistrements qui étaient traités.
J'ai ajouté un inputbox, pour faire des tests et ne pas parcourir toute ma table à chaque fois (une minute pour 100 enregistrements ...).
Le but de ma macro :
J'ai deux tables "WorkOrder", qui comprend des ordres de fabrications et "WorkOrderRouting" qui comprend les séquences de ceux ci.
Sauf que les données viennent de la base AdventureWorks2016 et ne sont pas parfaites : chaque séquence, ont la même date de début et de fin que l'OF en lui même, alors que je voudrais des périodes qui s'enchainent.
Ma logique est donc
Je parcours ma table d'OF
Je cherche dans ma table de séquence, les séquences qui concernent cet OF : je somme la durée de chaque séquence, et je stock le nombre de séquence.
Je reparcours une seconde fois mes séquences, pour répartir ma durée total ...
Je ne sais pas si mes recordset sont bien fait ... Je me pose de plus en plus la question, quand je vois que même sur 100 enregistrements, j'ai access qui freeze, et je ne peux même pas voir mes Debug.print, pour voir quel parti du code peut poser problème ...
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
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
| Sub DecoupageOFParSequence()
' Déclaration des variables
Dim BDD As DAO.Database
Dim RS_WORKORDERROUTING As DAO.Recordset
Dim RS_WORKORDER As DAO.Recordset
Dim FILTRE As String
Dim DATEDEBUT As Date
Dim DATEFIN As Date
Dim DATEINVERVAL As Date
Dim DUREESEQUENCE As Double
Dim NBSEQUENCE As Integer
Dim LANCEMENT As Date
Dim DATEDEBUT_SCHEDULED As Date
Dim DATEFIN_SCHEDULED As Date
Dim DATEINVERVAL_SCHEDULED As Date
Dim DUREESEQUENCE_SCHEDULED As Double
Dim CPT, CPTECIBLE As Integer
' Initialisation de la BDD
Set BDD = CurrentDb
' Initilisation des recordset
Set RS_WORKORDERROUTING = BDD.OpenRecordset("Production_WorkOrderRouting", dbOpenDynaset)
Set RS_WORKORDER = BDD.OpenRecordset("Production_WorkOrder", dbOpenDynaset)
CPTCIBLE = CInt(InputBox("Saisir le dernier enregistrement à lire"))
CPT = 0
ScreenUpdating = False
LANCEMENT = Now
' On se place sur le premier enregistrement du recordset WorkOrder
RS_WORKORDER.MoveFirst
Debug.Print "Passage du move First"
' On parcours entierement le recordset WorkOrder
Do Until RS_WORKORDER.EOF Or CPT > CPTCIBLE
Debug.Print "Début du do until : " & CPT & " enregistrement"
' On chaque boucle, on remet a 0 les variables DUREESEQUENCE et NBSEQUENCE
DUREESEQUENCE = 0
DUREESEQUENCE_SCHEDULED = 0
NBSEQUENCE = 0
' On cree un filtre avec le WorkOrderID
FILTRE = "WorkOrderID=" + Str(RS_WORKORDER![WorkOrderID]) + ""
' On cherche dans le recordset WorkOrderRouting les enregistrements qui repondent a ce filtre
RS_WORKORDERROUTING.FindFirst FILTRE
' Tant qu'on trouve un element, on continue de chercher
Do Until RS_WORKORDERROUTING.NoMatch = True
Debug.Print "Passage dans le second do until"
' On ajoute la duree de la sequence a la somme des durees
DUREESEQUENCE = DUREESEQUENCE + RS_WORKORDERROUTING![ActualResourceHrs]
DUREESEQUENCE_SCHEDULED = DUREESEQUENCE_SCHEDULED + RS_WORKORDERROUTING![PlannedResourceHrs]
' On incremente le nombre de sequence
NBSEQUENCE = NBSEQUENCE + 1
' On recherche l'enregistrement suivant qui repond au filtre
RS_WORKORDERROUTING.FindNext FILTRE
Loop
' Si le nombre de sequence est different de 0,
' Signifi que nous avons trouve precedement des resultats dans WorkOrderRouting pour notre filtre
If NBSEQUENCE <> 0 Then
Debug.Print "Passage dans le if"
' On recupere la date de debut et de fin de l'OF
DATEDEBUT = RS_WORKORDER![StartDate]
DATEFIN = RS_WORKORDER![EndDate]
DATEDEBUT_SCHEDULED = DATEDEBUT
DATEFIN_SCHEDULED = RS_WORKORDER![DueDate]
' On calcule l'interval de vide
' Date fin moins date de debut, moins la somme des sequences
DATEINVERVAL = DATEFIN - DATEDEBUT - DUREESEQUENCE / 24
DATEINVERVAL_SCHEDULED = DATEFIN_SCHEDULED - DATEDEBUT_SCHEDULED - DUREESEQUENCE_SCHEDULED / 24
' On se replace sur le premier enregistrement repondant au filtre
RS_WORKORDERROUTING.FindFirst FILTRE
' Tant qu'on trouve un element
Do Until RS_WORKORDERROUTING.NoMatch = True
Debug.Print "Passage dans le do until de mise à jour"
RS_WORKORDERROUTING.Edit
' On affecte la date de debut a la sequence
RS_WORKORDERROUTING![ActualStartDate] = DATEDEBUT
RS_WORKORDERROUTING![ScheduledStartDate] = DATEDEBUT_SCHEDULED
' On modifie la date de fin.
' On ajoute a la date de debut :
' la date interval, reparti par sequence, converti en minutes
' la duree de la sequence, converti en minutes
RS_WORKORDERROUTING![ActualEndDate] = DateAdd("n", ((DATEINVERVAL / NBSEQUENCE) * 24 * 60 + RS_WORKORDERROUTING![ActualResourceHrs] * 60), DATEDEBUT)
RS_WORKORDERROUTING![ScheduledEndDate] = DateAdd("n", ((DATEINVERVAL_SCHEDULED / NBSEQUENCE) * 24 * 60 + RS_WORKORDERROUTING![PlannedResourceHrs] * 60), DATEDEBUT_SCHEDULED)
' MAJ de l'enregistrement
RS_WORKORDERROUTING.Update
' La date de fin devient la nouvelle date de debut pour la sequence suivante
DATEDEBUT = RS_WORKORDERROUTING![ActualEndDate]
DATEDEBUT_SCHEDULED = RS_WORKORDERROUTING![ScheduledEndDate]
' On cherche l'enregistrement suivant
RS_WORKORDERROUTING.FindNext FILTRE
Loop
End If
' On passe au prochain enregistrement du recordset WorkOrder
RS_WORKORDER.MoveNext
CPT = CPT + 1
Loop
ScreenUpdating = True
MsgBox Format(LANCEMENT - Now, "hh:nn:ss")
End Sub |
Encore merci pour votre aide,
