Optimisation Macro VBA - RecordSet

**Maximenui** · 19/07/2022, 00h06

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 vba :

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
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,

**fclus** · 19/07/2022, 16h07

La 1ère boucle est inutile
Tu crées une requête (Qry1) sur WorkOrder et WorkOrderRouting en faisant une somme sur la durée et un compte du nombre de séquences
Pour répartir ta durée, tu fais une moyenne ? auquel cas, pour chaque record de Qry1, tu fais un update sur ta table WorkOrderRouting

**Maximenui** · 19/07/2022, 19h03

Merci fclus pour ta réponse,

Hier avant de me coucher je me demandais si je ne devais pas m'orienter vers du sql ...

J'ai modifié mon code, à voir si c'est à ça que tu pensais.

Je fais un recordset via requête SQL pour récupérer les infos que je veux, datedébut, datefin, durée etc ..., et je garde uniquement lorsque le count est supérieur à 1 (si 1, pas besoin de répartir le temps ... ).

Ensuite je parcours ce recordset, et je fais une nouvelle requête SQL sur ma table WorkOrderRouting, avec comme filtre mon numéro ID. J'ai déjà mes infos nécessaires aux modifs/calcul, je fais mon edit/update directement là (je ne savais pas qu'on pouvait faire un update depuis un recordset d'origine SQL, et que cela modifie la table d'origine ... ).

J'ai pas encore lancé sur la totalité de mes données, mais je pense que ça optimise pas mal !

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
Sub DecoupageOFParSequenceV3()
 
' Déclaration des variables
Dim BDD As DAO.Database
Dim RS_WORKORDERROUTING As DAO.Recordset
Dim RS_QUERYSQL As DAO.Recordset
 
Dim DATEDEBUT As Date
Dim DATEFIN As Date
Dim DATEINVERVAL As Date
Dim DUREESEQUENCE As Double
Dim NBSEQUENCE As Integer
Dim FILTREWORKORDERROUTING As String
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
 
LANCEMENT = Now
 
ScreenUpdating = False
Dim SQL As String
 
' Initialisation de la BDD
Set BDD = CurrentDb
 
' Initilisation des recordset
Set RS_QUERYSQL = BDD.OpenRecordset("Requête2")
 
RS_QUERYSQL.MoveFirst
CPT = 0
 
Do Until RS_QUERYSQL.EOF Or CPT > 100
 
    FILTREWORKORDERROUTING = "WorkOrderId=" & RS_QUERYSQL![WorkOrderID]
 
 
    NBSEQUENCE = RS_QUERYSQL![NBSEQUENCE]
    DATEDEBUT = RS_QUERYSQL![StartDate]
    DATEFIN = RS_QUERYSQL![EndDate]
    DUREESEQUENCE = RS_QUERYSQL![ActualInterval]
 
    DATEINVERVAL = DATEFIN - DATEDEBUT - DUREESEQUENCE / 24
 
 
    DATEDEBUT_SCHEDULED = RS_QUERYSQL![StartDate]
    DATEFIN_SCHEDULED = RS_QUERYSQL![DueDate]
    DUREESEQUENCE_SCHEDULED = RS_QUERYSQL![PlannedInterval]
 
    DATEINVERVAL_SCHEDULED = DATEFIN_SCHEDULED - DATEDEBUT_SCHEDULED - DUREESEQUENCE_SCHEDULED / 24
 
    Set RS_WORKORDERROUTING = BDD.OpenRecordset("Select ScheduledStartDate, ScheduledEndDate, ActualStartDate, ActualEndDate, PlannedResourceHrs, ActualResourceHrs FROM Production_WorkOrderRouting WHERE WorkOrderID =" & RS_QUERYSQL![WorkOrderID] & ";")
 
    RS_WORKORDERROUTING.MoveFirst
 
    Do Until RS_WORKORDERROUTING.EOF
 
        'MsgBox RS_WORKORDERROUTING![ActualResourceHrs]
 
        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]
 
        RS_WORKORDERROUTING.MoveNext
 
        'MsgBox RS_WORKORDERROUTING![ActualResourceHrs]
 
    Loop
    CPT = CPT + 1
    RS_QUERYSQL.MoveNext
 
Loop
 
ScreenUpdating = True
 
MsgBox Format(Now - LANCEMENT, "hh:nn:ss")
 
End Sub

Avec ma première requête :

Code SQL :

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

1
2
3
4
5
SELECT Production_WorkOrderRouting.WorkOrderID, Count(*) AS NbSequence, Sum(Production_WorkOrderRouting.PlannedResourceHrs) AS PlannedInterval, Sum(Production_WorkOrderRouting.ActualResourceHrs) AS ActualInterval, StartDate, EndDate, DueDate
FROM Production_WorkOrderRouting, Production_WorkOrder
WHERE Production_WorkOrderRouting.WorkOrderID = Production_WorkOrder.WorkOrderID
GROUP BY Production_WorkOrderRouting.WorkOrderID, StartDate, EndDate, DueDate
HAVING Count(*) >1;

Optimisation Macro VBA - RecordSet

VBA Access

Discussions similaires

Partager

Partager