Sub ajuste_nbUsagers()
Dim R()
Dim n As Double, DATA(), ERP, Us, J, HDéb As Integer, Hfin As Integer, dDurée As Double, durCrén As Double
Dim c As Range
Application.ScreenUpdating = False
DATA = Feuil6.Range("A1:N" & Feuil6.Range("A100000").End(xlUp).Row).Value
ttt = Timer
For u = 2 To UBound(DATA, 1)
n = 0
'Récupération des infos sur le créneau étudié : Installation, Usager, Date, Heure de début et de fin, durée du créneau
ERP = Feuil6.Range("C" & u)
Us = Feuil6.Range("F" & u)
J = Feuil6.Range("I" & u)
HDéb = Feuil6.Range("J" & u) 'String(4 - Len(Feuil8.Range("J" & ligne)), "0") & Feuil8.Range("J" & ligne)
Hfin = Feuil6.Range("K" & u) 'String(4 - Len(Feuil8.Range("K" & ligne)), "0") & Feuil8.Range("K" & ligne)
durCrén = Feuil6.Range("M" & u)
'Le tableau étant trié par date, je commence à la bonne date, pour pas regarder toute les lignes
Set c = Feuil6.Range("I:I").Find(what:=J, LookIn:=xlFormulas, lookat:=xlWhole)
'***************************************************************'
'(j'aurais pu avantageusement je pense mettre à la place, déjà :
'Set c = Feuil6.Range("I" & Application.match(J, feuil6.range("I1:I100000"),0))
'***************************************************************'
décal = 0
'******************************************************************
'ensuite je me balade dans le tableau, j'aurais certainement dû utiliser le Tableau DATA plutôt que des cellules...
'******************************************************************
Do While c.Offset(décal, 0) = J 'Si bonne date'
If Cells(c.Offset(décal, 0).Row, 3) = ERP And Cells(c.Offset(décal, 0).Row, 9) = J Then
dDurée = 0
If (Format(Cells(c.Offset(décal, 0).Row, 10), "0000") <= Format(HDéb, "0000") And Format(Cells(c.Offset(décal, 0).Row, 11), "0000") > Format(HDéb, "0000")) Or (Format(Cells(c.Offset(décal, 0).Row, 10), "0000") < Format(Hfin, "0000") And Format(Cells(c.Offset(décal, 0).Row, 11), "0000") >= Format(Hfin, "0000")) Or (Format(Cells(c.Offset(décal, 0).Row, 10), "0000") <= Format(Hfin, "0000") And Format(Cells(c.Offset(décal, 0).Row, 11), "0000") >= Format(HDéb, "0000")) Then
dDurée = Val(Left(Application.Min(Cells(c.Offset(décal, 0).Row, 11), Hfin), Len(Application.Min(Cells(c.Offset(décal, 0).Row, 11), Hfin)) - 2)) - Val(Left(Application.Max(Cells(c.Offset(décal, 0).Row, 10), HDéb), Len(Application.Max(Cells(c.Offset(décal, 0).Row, 10), HDéb)) - 2)) + (Val(Right(Application.Min(Cells(c.Offset(décal, 0).Row, 11), Hfin), 2)) - Val(Right(Application.Max(Cells(c.Offset(décal, 0).Row, 10), HDéb), 2))) / 60
n = n + dDurée / durCrén 'calcul du nbre d'usagers qui se cumule
End If
If c.Offset(décal, 1) > Hfin Then Exit Do 'sortie anticipée de la boucle si l'horaire est dépassé
End If
décal = décal + 1
Loop
ReDim Preserve R(1 To u - 1)
R(u - 1) = n
Next
Debug.Print "nbusagers ", Timer - ttt
Application.ScreenUpdating = True
'Affichage du résultat'
Feuil6.Range("S2").Resize(UBound(R, 1), 1) = Application.Transpose(R)
End Sub