Bonjour à tous,
J'ai un fichier avec une grande quantité de lignes (6620), chaque ligne correspond a une activité et comporte le poids relatif de l’activité, la date de début et la date de fin entre autres données.
Je cherche a distribuer le poids de chaque activité sur une échelle de temps puis faire le total pour chaque jour de mon calendrier.
Exemple :
J'ai donc crée une macro et pour chaque activité je vais renseigner les cellules qui correspondent aux dates d’exécution de mon activité avec le poids distribué sur chaque jour dans mon onglet.
J'ai utilise un tableau pour charger tous les poids et un autre pour toutes dates (2 ans et 9 mois soit un peu plus de 1000 colonnes), voici ma macro
Cette macro fonctionne et met 6 minutes pour s’exécuter.
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 Sub Weight_Distribution_Baseline() Dim wkA As Workbook Set wkA = ThisWorkbook Dim Data As Worksheet Set Data = ThisWorkbook.Sheets("BL Data") Dim BSL As Worksheet Set BSL = ThisWorkbook.Sheets("Baseline") Dim FCST As Worksheet 'Set FCST = ThisWorkbook.Sheets("Forecast") Dim ACT As Worksheet 'Set ACT = ThisWorkbook.Sheets("Actual") Dim Tab_Weight() As String 'Declaration du tableau 1 Dim Tab_Date() As String 'Declaration du tableau 2 Dim Tab_Dist() As String 'Declaration du tableau 3 Dim File_Path As String, Name_File As String Dim Scale_Date As Range Set Scale_Date = BSL.Range("C1") Dim Date_Bsl As Range Set Date_Bsl = Data.Range("K6") Dim Act_ID As Range Set Act_ID = Data.Range("C6") Dim Wght As Range Set Wght = Data.Range("O6") Dim Data_Date As Range Set Data_Date = wkA.Sheets("General").Range("C1") Dim NbLine As Integer Dim NbCol As Integer Dim NbDays As Long Dim Start As Long Dim Project_Start As Range Set Project_Start = Data.Range("D2") Dim i As Integer Dim j As Integer Dim k As Integer Dim T As Double T = Timer With wkA.Sheets("BL Data") NbLine = .Cells(.Rows.Count, 4).End(xlUp).Row ' Compte le nombre de ligne de la feuille BL_DATA End With With wkA.Sheets("Baseline") NbCol = Scale_Date.End(xlToRight).Column - 2 'On compte le nombre de colonne a partir de la cellule C1 (-2) End With ReDim Tab_Weight(0 To NbLine) For i = 0 To UBound(Tab_Weight) Tab_Weight(i) = Wght.Offset(i, 0) Next i ReDim Tab_Date(0 To NbCol) For j = 0 To UBound(Tab_Date) Tab_Date(j) = Scale_Date.Offset(0, j) Next j For i = 0 To NbLine - 5 If Date_Bsl.Offset(i, 0) < Project_Start Then 'Si l'activite a commence avant le debut du projet Start = Project_Start ElseIf Date_Bsl.Offset(i, 0) >= Project_Start Then 'Si l'activite a commence apres le debut du projet Start = Date_Bsl.Offset(i, 0) End If NbDays = Date_Bsl.Offset(i, 1) - Start If NbDays <= 0 Then NbDays = 1 End If k = 0 j = 0 If Wght.Offset(i, 0) <> 0 Then ' Si le poids de l'activite n'est pas nul While k <= NbDays ' + 1 If NbDays > 1 And Start <> Project_Start And InStr(Date_Bsl.Offset(i, 0), Scale_Date.Offset(0, j)) Then For k = 0 To NbDays Scale_Date.Offset(i + 1, j + k) = Tab_Weight(i) / (NbDays + 1) ' Ici on precise (i+1) car Scale_Date a pour Ref C1 Next k End If If NbDays > 1 And Start = Project_Start Then For k = 0 To NbDays Scale_Date.Offset(i + 1, j + k) = Tab_Weight(i) / (NbDays + 1) ' Ici on precise (i+1) car Scale_Date a pour Ref C1 Next k End If If NbDays = 1 And Start > Project_Start And InStr(Date_Bsl.Offset(i, 0), Scale_Date.Offset(0, j)) Then Scale_Date.Offset(i + 1, j + k) = Tab_Weight(i) k = k + 1 ElseIf NbDays = 1 And Start = Project_Start Then k = k + 1 End If j = j + 1 Wend If NbDays = 1 And Date_Bsl.Offset(i, 0) <= Project_Start Then Scale_Date.Offset(i + 1, 0) = Tab_Weight(i) k = k + 1 End If Else Scale_Date.Offset(i + 1, 0) = "0" End If Next i MsgBox Application.Round((Timer - T), 1) & " Sec" End Sub
J'ai donc pensé travailler directement dans un tableau pour aller plus vite et de mettre le total calculé pour chaque jours dans un onglet , donc dans seulement 1000 cellules et quelque.
Je vais donc charger mes tableaux, effectuer ma répartition a l’intérieur de l'un deux puis renseigner mes cellules à la fin.
Voici le résultat
Contre toute attente, ce dernier code est plus lent que le premier, entre 9 et 10 minutes.
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 Sub Weight_Distribution_Baseline_Using_Vba_Table() Dim wkA As Workbook Set wkA = ThisWorkbook Dim Data As Worksheet Set Data = ThisWorkbook.Sheets("BL Data") Dim TRT As Worksheet Set TRT = ThisWorkbook.Sheets("Treatment") Dim BSL As Worksheet Set BSL = ThisWorkbook.Sheets("Baseline") Dim FCST As Worksheet 'Set FCST = ThisWorkbook.Sheets("Forecast") Dim ACT As Worksheet 'Set ACT = ThisWorkbook.Sheets("Actual") Dim Tab_Weight() As String 'Declaration du tableau 1 Dim Tab_Date() As String 'Declaration du tableau 2 Dim Tab_Dist() 'As String 'Declaration du tableau 3 Dim Tab_Bsl() 'As String 'Declaration du tableau 4 Dim File_Path As String, Name_File As String Dim Scale_Date As Range Set Scale_Date = BSL.Range("C1") Dim Date_Bsl As Range Set Date_Bsl = Data.Range("K6") Dim Act_ID As Range Set Act_ID = Data.Range("C6") Dim Wght As Range Set Wght = Data.Range("O6") Dim Data_Date As Range Dim BslTrt As Range Set BslTrt = TRT.Range("C5") Set Data_Date = wkA.Sheets("General").Range("C1") Dim NbLine As Integer Dim NbCol As Integer Dim NbDays As Long Dim Start As Long Dim Project_Start As Range Set Project_Start = Data.Range("D2") Dim i As Integer Dim j As Integer Dim k As Integer Dim T As Double T = Timer 'Exemple pour lire valeur Table:Debug.Print Tab_Dist(i, j + k) With wkA.Sheets("BL Data") NbLine = .Cells(.Rows.Count, 4).End(xlUp).Row ' Compte le nombre de ligne de la feuille BL_DATA End With With wkA.Sheets("Baseline") NbCol = Scale_Date.End(xlToRight).Column - 2 'On compte le nombre de colonne a partir de la cellule C1 (-2) End With ReDim Tab_Weight(0 To NbLine) For i = 0 To UBound(Tab_Weight) Tab_Weight(i) = Wght.Offset(i, 0) Next i ReDim Tab_Date(0 To NbCol) For j = 0 To UBound(Tab_Date) Tab_Date(j) = Scale_Date.Offset(0, j) Next j ReDim Tab_Dist(0 To NbLine, 0 To NbCol * 2) 'Ici on redimensionne la deuxieme dimension du tableau en multipliant par deux ' car on peut avoir une valeur > a NbCol si k>1 For i = 0 To NbLine - 5 If Date_Bsl.Offset(i, 0) < Project_Start Then 'Si l'activite a commence avant le debut du projet Start = Project_Start ElseIf Date_Bsl.Offset(i, 0) >= Project_Start Then 'Si l'activite a commence apres le debut du projet Start = Date_Bsl.Offset(i, 0) End If NbDays = Date_Bsl.Offset(i, 1) - Start If NbDays <= 0 Then NbDays = 1 End If k = 0 j = 0 If Wght.Offset(i, 0) <> 0 Then While k <= NbDays ' + 1 If NbDays > 1 And Start <> Project_Start And InStr(Date_Bsl.Offset(i, 0), Scale_Date.Offset(0, j)) Then For k = 0 To NbDays Tab_Dist(i, j + k) = Tab_Weight(i) / (NbDays + 1) ' Ici on precise (i+1) car Scale_Date a pour Ref C1 Next k End If If NbDays > 1 And Start = Project_Start Then For k = 0 To NbDays Tab_Dist(i, j + k) = Tab_Weight(i) / (NbDays + 1) ' Ici on precise (i+1) car Scale_Date a pour Ref C1 Next k End If If NbDays = 1 And Start > Project_Start And InStr(Date_Bsl.Offset(i, 0), Scale_Date.Offset(0, j)) Then Tab_Dist(i, j + k) = Tab_Weight(i) k = k + 1 ElseIf NbDays = 1 And Start = Project_Start Then k = k + 1 End If j = j + 1 Wend If NbDays = 1 And Date_Bsl.Offset(i, 0) <= Project_Start Then Tab_Dist(i, 0) = Tab_Weight(i) k = k + 1 End If Else Tab_Dist(i + 1, 0) = "0" End If Next i ReDim Tab_Bsl(0 To NbCol) For i = 0 To NbCol For j = 0 To NbLine Tab_Bsl(i) = Tab_Dist(j, i) + Tab_Bsl(i) Debug.Print Tab_Bsl(i) Next j Next i For i = 0 To NbCol BslTrt.Offset(0, i).Value = Tab_Bsl(i) Next i MsgBox Application.Round((Timer - T), 1) & " Sec" End Sub
Ayant lu que l'utilisation des tableaux pouvait accélérer le traitement, je commence a m'y mettre, mais le résultat n'est pas convainquant pour l'utilisation que j'en fais en tout cas.
Ai-je encore zappé quelque chose?
Merci pour vos conseils
Eric
Partager