Option Explicit
Sub test()
Dim a, w(), i As Long, n As Long, e, txt As String
Dim Debut As Date, Fin As Date, dico As Object
a = Sheets("Base").Cells(1).CurrentRegion.Value
Debut = CDate("05/03/2016"): Fin = CDate("30/03/2016")
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
For i = 2 To UBound(a, 1)
If Not dico.exists(a(i, 1)) Then
Set dico(a(i, 1)) = _
CreateObject("Scripting.Dictionary")
dico(a(i, 1)).CompareMode = 1
End If
txt = Join(Array(a(i, 2), a(i, 3)), "")
If Not dico(a(i, 1)).exists(txt) Then
If dico(a(i, 1)).Count = 0 Then
dico(a(i, 1))(txt) = VBA.Array(a(i, 1), txt, 1, IIf(a(i, 4) >= Debut And a(i, 4) <= Fin, 1, Empty))
Else
dico(a(i, 1))(txt) = VBA.Array(Empty, txt, 1, IIf(a(i, 4) >= Debut And a(i, 4) <= Fin, 1, Empty))
End If
Else
w = dico(a(i, 1))(txt)
w(2) = w(2) + 1
If a(i, 4) >= Debut And a(i, 4) <= Fin Then w(3) = w(3) + 1
dico(a(i, 1))(txt) = w
End If
Next
Application.ScreenUpdating = False
With Sheets("Feuil1").Cells(1)
.CurrentRegion.Clear: n = 1
.Resize(1, 4).Value = [{"Agent","Typologie d'affaire","Nombre d'affaires total","Nombre d'affaires sur la période entrée"}]
For Each e In dico.keys
With .Offset(n).Resize(dico(e).Count, 4)
.Value = Application.Transpose(Application.Transpose(dico(e).items))
With .Offset(dico(e).Count).Resize(1)
.Interior.ColorIndex = 36
.BorderAround Weight:=xlThin
.Cells(1, 1) = "Total " & e
.Cells(1, 2) = dico(e).Count
.Cells(1, 3) = Application.Sum(Application.index(dico(e).items, 0, 3))
.Cells(1, 4) = Application.Sum(Application.index(dico(e).items, 0, 4))
End With
n = n + dico(e).Count + 1
End With
Next
With .CurrentRegion
.Font.Name = "calibri"
.Font.Size = 10
.VerticalAlignment = xlCenter
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
With .Rows(1)
.Font.Size = 11
.HorizontalAlignment = xlCenter
.BorderAround Weight:=xlThin
.Interior.ColorIndex = 40
End With
.Columns.AutoFit
End With
.Parent.Activate
End With
Application.ScreenUpdating = True
Set dico = Nothing
End Sub