Function RecapJour(xSource As Range, Action As String, leJour As Date)
Dim t, dico, i&, j&, N&, plage, r, res
t = xSource.Value2
Set plage = Application.Caller
ReDim res(1 To plage.Rows.Count, 1 To plage.Columns.Count)
For i = 1 To UBound(res): For j = 1 To UBound(res, 2): res(i, j) = "": Next j: Next i
Set dico = CreateObject("scripting.dictionary")
dico.CompareMode = vbTextCompare
For i = 1 To UBound(t)
If LCase(t(i, 1)) = LCase(Action) And t(i, 2) = leJour Then
If Not dico.Exists(t(i, 5)) Then N = N + 1: dico(t(i, 5)) = N
End If
Next i
If dico.Count = 0 Then RecapJour = res: Exit Function
ReDim r(1 To dico.Count, 1 To 4)
For i = 1 To UBound(t)
If LCase(t(i, 1)) = LCase(Action) And t(i, 2) = leJour Then
N = dico(t(i, 5))
r(N, 1) = t(i, 5): r(N, 2) = r(N, 2) + t(i, 6)
r(N, 3) = t(i, 7): r(N, 4) = r(N, 4) + t(i, 6) * t(i, 7)
End If
Next i
On Error Resume Next
For i = 1 To UBound(r): For j = 1 To UBound(r, 2): res(i, j) = r(i, j): Next j: Next i
RecapJour = res
End Function