Function FréqTauxOcc(TypCalcul As Integer, CritJour As String, CritH)
'TypCalCul : 0 = Fréquentation horaire moyenne, 1 = Taux d'occupation
Dim CritEq As String, CritTyp As String, CritUsager As String, CritMoisDéb As String, CritMoisFin As String
Dim d(0 To 50, 0 To 3), t As String, i As Long, j As Integer, CritHF As Double, CritHD As Double
Dim sSom As Double, sNb As Integer, sMax As Double, x As Double, txOc As Double
'0 to 3 : Nom de l'Equipement, SomFréqH, NbFréqH, MaxFréqH
Application.Volatile
CritEq = Range("C_Eq")
CritTyp = Range("C_Typ")
CritUsager = Range("C_Us")
CritMoisDéb = Range("C_MD")
CritMoisFin = Range("C_MF")
CritHF = CritH + 59 / 60 / 24
CritHD = CritH
t = "*" & CritEq & "*" & Chr(1) & _
"*" & CritTyp & "*" & Chr(1) & _
"*" & CritUsager & "*" & Chr(1) & _
"*" & CritJour & "*"
j = 0
For i = 1 To UBound(Eq)
If Eq(i, 1) & Chr(1) & Typ(i, 1) & Chr(1) & Usager(i, 1) & Chr(1) & Jour(i, 1) Like t Then
If Mois(i, 1) >= CritMoisDéb And Mois(i, 1) <= CritMoisFin And Application.Round(CDbl(HD(i, 1)), 6) <= Application.Round(CDbl(CritH), 6) And Application.Round(CDbl(HF(i, 1)), 6) >= Application.Round(CDbl(CritH), 6) - IIf(Application.Round(CDbl(CritH), 6) >= 22, 0.1, 0) Then
TrouvedsTableau = False
For k = LBound(d, 1) To UBound(d, 1)
If d(k, 0) = Eq(i, 1) Then TrouvedsTableau = True: Exit For
Next k
If TrouvedsTableau Then
d(k, 1) = d(k, 1) + CDbl(FréqH(i, 1))
d(k, 2) = d(k, 2) + 1
If CDbl(FréqH(i, 1)) > d(k, 3) Then d(k, 3) = CDbl(FréqH(i, 1))
Else
d(j, 0) = Eq(i, 1)
d(j, 1) = CDbl(FréqH(i, 1))
d(j, 2) = 1
d(j, 3) = CDbl(FréqH(i, 1))
j = j + 1
End If
End If
End If
Next
If j = 0 Then
txOc = -1
Else
x = 0: y = 0
For i = 0 To j - 1
sSom = 0: sNb = 0
sSom = d(i, 1) + sSom
sNb = sNb + d(i, 2)
sMax = sMax + d(i, 3)
x = x + sSom / sNb
y = y + 1
' Debug.Print x, y, x / y
Next
txOc = x / y
If TypCalcul = 1 Then txOc = txOc / sMax * y 'Taux d'occupation du bâtiment
End If
FréqTauxOcc = txOc
End Function
),
