déterminer la quantité d'élements par pas de 30 minutes

Bonjour à tous.

J'ai un listing constitué d'événement horaires et je cherche à déterminer la quantité d'événement par pas de 30 minutes.

J'ai déjà un code (rédigé il y longtemps) qui fonctionne (cf ci-dessous). Mais comme vous pourrez le remarquer j'ai au minimum 50 variables pour effectuer cette analyse. Il fonctionne ainsi :
-si élément du listing que je regarde est compris entre la plage temporelle Xn et la plage temporelle Yn et bien la variable de cette plage prend la quantité +1. C 'est bête et méchant. Mais super long dans la rédaction...

Vous avez une idée d'approche plus compacte à me proposer?

Merci par avance. :D

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
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
Sub repartition()
'cree un listing de répartition horaire
 
horaire = 4
 
 
 
Do Until Cells(horaire, 1) = ""
 
a1 = 0
a2 = 0
a3 = 0
a4 = 0
a5 = 0
a6 = 0
a7 = 0
a8 = 0
a9 = 0
a10 = 0
a11 = 0
a12 = 0
a13 = 0
a14 = 0
a15 = 0
a16 = 0
a17 = 0
a18 = 0
a19 = 0
a20 = 0
a21 = 0
a22 = 0
a23 = 0
a24 = 0
a25 = 0
a26 = 0
a27 = 0
a28 = 0
a29 = 0
a30 = 0
a31 = 0
a32 = 0
a33 = 0
a34 = 0
a35 = 0
a36 = 0
a37 = 0
a38 = 0
a39 = 0
a40 = 0
a41 = 0
a42 = 0
a43 = 0
a44 = 0
a45 = 0
a46 = 0
a47 = 0
a48 = 0
 
 
x = 0
 
demi = 2.08333333333333E-02 'valeur correspondante à 30 minutes
 
    Do Until Cells(horaire + x, 1) = ""
 
 
      If Cells(horaire + x, 7) >= 0 And Cells(horaire + x, 7) < demi Then
      a1 = a1 + 1
      End If
 
      If Cells(horaire + x, 7) >= demi And Cells(horaire + x, 7) < 2 * demi Then
       a2 = a2 + 1
      End If
 
      If Cells(horaire + x, 7) >= 2 * demi And Cells(horaire + x, 7) < 3 * demi Then
      a3 = a3 + 1
      End If
 
      If Cells(horaire + x, 7) >= 3 * demi And Cells(horaire + x, 7) < 4 * demi Then
       a4 = a4 + 1
      End If
 
       If Cells(horaire + x, 7) >= 4 * demi And Cells(horaire + x, 7) < 5 * demi Then
      a5 = a5 + 1
      End If
 
      If Cells(horaire + x, 7) >= 5 * demi And Cells(horaire + x, 7) < 6 * demi Then
       a6 = a6 + 1
      End If
 
       If Cells(horaire + x, 7) >= 6 * demi And Cells(horaire + x, 7) < 7 * demi Then
      a7 = a7 + 1
      End If
 
      If Cells(horaire + x, 7) >= 7 * demi And Cells(horaire + x, 7) < 8 * demi Then
       a8 = a8 + 1
      End If
 
       If Cells(horaire + x, 7) >= 8 * demi And Cells(horaire + x, 7) < 9 * demi Then
      a9 = a9 + 1
      End If
 
      If Cells(horaire + x, 7) >= 9 * demi And Cells(horaire + x, 7) < 10 * demi Then
       a10 = a10 + 1
      End If
 
       If Cells(horaire + x, 7) >= 10 * demi And Cells(horaire + x, 7) < 11 * demi Then
      a11 = a11 + 1
      End If
 
      If Cells(horaire + x, 7) >= 11 * demi And Cells(horaire + x, 7) < 12 * demi Then
       a12 = a12 + 1
      End If
 
       If Cells(horaire + x, 7) >= 12 * demi And Cells(horaire + x, 7) < 13 * demi Then
      a13 = a13 + 1
      End If
 
      If Cells(horaire + x, 7) >= 13 * demi And Cells(horaire + x, 7) < 14 * demi Then
       a14 = a14 + 1
      End If
 
 
       If Cells(horaire + x, 7) >= 14 * demi And Cells(horaire + x, 7) < 15 * demi Then
      a15 = a15 + 1
      End If
 
      If Cells(horaire + x, 7) >= 15 * demi And Cells(horaire + x, 7) < 16 * demi Then
       a16 = a16 + 1
      End If
 
       If Cells(horaire + x, 7) >= 16 * demi And Cells(horaire + x, 7) < 17 * demi Then
      a17 = a17 + 1
      End If
 
      If Cells(horaire + x, 7) >= 17 * demi And Cells(horaire + x, 7) < 18 * demi Then
       a18 = a18 + 1
      End If
 
 
       If Cells(horaire + x, 7) >= 18 * demi And Cells(horaire + x, 7) < 19 * demi Then
      a19 = a19 + 1
      End If
 
      If Cells(horaire + x, 7) >= 19 * demi And Cells(horaire + x, 7) < 20 * demi Then
       a20 = a20 + 1
      End If
 
 
 
       If Cells(horaire + x, 7) >= 20 * demi And Cells(horaire + x, 7) < 21 * demi Then
      a21 = a21 + 1
      End If
 
      If Cells(horaire + x, 7) >= 21 * demi And Cells(horaire + x, 7) < 22 * demi Then
       a22 = a22 + 1
      End If
 
 
       If Cells(horaire + x, 7) >= 22 * demi And Cells(horaire + x, 7) < 23 * demi Then
      a23 = a23 + 1
      End If
 
      If Cells(horaire + x, 7) >= 23 * demi And Cells(horaire + x, 7) < 24 * demi Then
       a24 = a24 + 1
      End If
 
 
       If Cells(horaire + x, 7) >= 24 * demi And Cells(horaire + x, 7) < 25 * demi Then
      a25 = a25 + 1
      End If
 
      If Cells(horaire + x, 7) >= 25 * demi And Cells(horaire + x, 7) < 26 * demi Then
       a26 = a26 + 1
      End If
 
       If Cells(horaire + x, 7) >= 26 * demi And Cells(horaire + x, 7) < 27 * demi Then
      a27 = a27 + 1
      End If
 
      If Cells(horaire + x, 7) >= 27 * demi And Cells(horaire + x, 7) < 28 * demi Then
       a28 = a28 + 1
      End If
 
 
       If Cells(horaire + x, 7) >= 28 * demi And Cells(horaire + x, 7) < 29 * demi Then
      a29 = a29 + 1
      End If
 
      If Cells(horaire + x, 7) >= 29 * demi And Cells(horaire + x, 7) < 30 * demi Then
       a30 = a30 + 1
      End If
 
       If Cells(horaire + x, 7) >= 30 * demi And Cells(horaire + x, 7) < 31 * demi Then
      a31 = a31 + 1
      End If
 
      If Cells(horaire + x, 7) >= 31 * demi And Cells(horaire + x, 7) < 32 * demi Then
       a32 = a32 + 1
      End If
 
       If Cells(horaire + x, 7) >= 32 * demi And Cells(horaire + x, 7) < 33 * demi Then
      a33 = a33 + 1
      End If
 
      If Cells(horaire + x, 7) >= 33 * demi And Cells(horaire + x, 7) < 34 * demi Then
       a34 = a34 + 1
      End If
 
       If Cells(horaire + x, 7) >= 34 * demi And Cells(horaire + x, 7) < 35 * demi Then
      a35 = a35 + 1
      End If
 
      If Cells(horaire + x, 7) >= 35 * demi And Cells(horaire + x, 7) < 36 * demi Then
       a36 = a36 + 1
      End If
 
       If Cells(horaire + x, 7) >= 36 * demi And Cells(horaire + x, 7) < 37 * demi Then
      a37 = a37 + 1
      End If
 
      If Cells(horaire + x, 7) >= 37 * demi And Cells(horaire + x, 7) < 38 * demi Then
       a38 = a38 + 1
      End If
 
       If Cells(horaire + x, 7) >= 38 * demi And Cells(horaire + x, 7) < 39 * demi Then
      a39 = a39 + 1
      End If
 
      If Cells(horaire + x, 7) >= 39 * demi And Cells(horaire + x, 7) < 40 * demi Then
       a40 = a40 + 1
      End If
 
       If Cells(horaire + x, 7) >= 40 * demi And Cells(horaire + x, 7) < 41 * demi Then
      a41 = a41 + 1
      End If
 
      If Cells(horaire + x, 7) >= 41 * demi And Cells(horaire + x, 7) < 42 * demi Then
       a42 = a42 + 1
      End If
 
       If Cells(horaire + x, 7) >= 42 * demi And Cells(horaire + x, 7) < 43 * demi Then
      a43 = a43 + 1
      End If
 
      If Cells(horaire + x, 7) >= 43 * demi And Cells(horaire + x, 7) < 44 * demi Then
       a44 = a44 + 1
      End If
 
       If Cells(horaire + x, 7) >= 44 * demi And Cells(horaire + x, 7) < 45 * demi Then
      a45 = a45 + 1
      End If
 
      If Cells(horaire + x, 7) >= 45 * demi And Cells(horaire + x, 7) < 46 * demi Then
       a46 = a46 + 1
      End If
 
       If Cells(horaire + x, 7) >= 46 * demi And Cells(horaire + x, 7) < 47 * demi Then
      a47 = a47 + 1
      End If
 
      If Cells(horaire + x, 7) >= 47 * demi And Cells(horaire + x, 7) < 48 * demi Then
       a48 = a48 + 1
      End If
 
       x = x + 1
 
    Loop
 
 
End Sub

Sens winZip!

bonjour,
je ne sais pas si c'est un truc comme ça que tu cherche!

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub repartition()'cree un listing de répartition horaire
horaire = 4: x = 0: demi = 2.08333333333333E-02 'valeur correspondante à 30 minutes
Dim A(1 To 48) As Long
Do Until Cells(horaire + x, 1) = ""
    For i = 0 To 47
        If Cells(horaire + x, 7) >= (demi * i) And Cells(horaire + x, 7) < (demi * i + 1) Then A(i + 1) = A(i + 1) + 1
        DoEvents
    Next
    x = x + 1
Loop
End Sub

Merci dysorthographie pour ton retour.

Je pense que ça correspond tout à fait à l'esprit de ce que je cherche à faire :D.

A part que je ne comprends pas bien le DoEvents (de ce je que comprend ca permet de continuer le travail sans action particulière?). Il faut maintenant que j'écrive le résultat à la place de ce DoEvents dans la feuille Excel.

en revanche mais je préfère avoir ton avis je pense qu'il y a une erreur:

Code:

If Cells(horaire + x, 7) >= (demi * i) And Cells(horaire + x, 7) < (demi * i + 1) Then A(i + 1) = A(i + 1) + 1

mais

Code:

If Cells(horaire + x, 7) >= (demi * i) And Cells(horaire + x, 7) < (demi * i + demi) Then A(i + 1) = A(i + 1) + 1

Non?

si i= 2
i * demi =(2 * demi) Non?

Code:

If Cells(horaire + x, 7) >= (demi * i)And Cells(horaire + x, 7) < (demi * i + 1)Then A(i + 1) = A(i + 1) + 1

Code:

If Cells(horaire + x, 7) >= (demi * 2)And Cells(horaire + x, 7) < (demi * 3)Then A(3) = A(3) + 1

pour mes test j'ai chargé la brouette et je n'avais plus la mais pour arrêter le code d'ou le DoEvents
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Sub repartition()'cree un listing de répartition horaire horaire = 4: x = 0: demi = 2.08333333333333E-02 'valeur correspondante à 30 minutes Dim A(1 To 48) As Long Do Until Cells(horaire + x, 1) = "" For i = 0 To 47 If Cells(horaire + x, 7) >= (demi * i) And Cells(horaire + x, 7) < (demi * i + 1) Then A(i + 1) = A(i + 1) + 1 DoEvents Next x = x + 1 Loop Sheets("Feuil2").Range("A1").Resize(UBound(A)) = Application.Transpose(A) End Sub

pour i = 2

dans ce cas:

Code:

If Cells(horaire + x, 7) >= (demi * i)And Cells(horaire + x, 7) < (demi * i + 1)Then A(i + 1) = A(i + 1) + 1

demi*2 = 0.416666666 soit 1 h et demi*2+1 = 1.0416666666 soit 1h00 mais un jour plus tard

c'est plus cela il manque une parenthèse pour le calcul:

Code:

If Cells(horaire + x, 7) >= (demi * i)And Cells(horaire + x, 7) < (demi *( i + 1)) Then A(i + 1) = A(i + 1) + 1

demi*(2+1) soit 0.0625 soit 1h30

Je peux récupérer les valeurs de A(i) je suppose? Si oui comment.

Merci encore

Edit je n'avais pas vu le complément de ta réponse :merci:

pour la parenthèse Ok!

tu as deux méthode pour écrire dans excel!
écrire tout le tableau A dans une colonne!

Code:

Sheets("Feuil2").Range("A1").Resize(UBound(A)) = Application.Transpose(A)

ou scanner le tableau A : UBound(A)
Code:

1 2 3 for i= 1 to UBound(A) MsgBox A(i) Next

Ca marche impec

Merci et bonne journée à tous.

à ton service!