Option Explicit
Sub test()
Dim a, i As Long, w(), n, y, e, v
a = Sheets("2014").Range("b2").CurrentRegion.Value
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 2 To UBound(a, 1)
If Not .exists(a(i, 1)) Then
Set .Item(a(i, 1)) = _
CreateObject("Scripting.Dictionary")
.Item(a(i, 1)).CompareMode = 1
End If
If Not .Item(a(i, 1)).exists(a(i, 3)) Then
ReDim w(1 To 5)
w(1) = a(i, 1): w(2) = a(i, 3): w(3) = a(i, 5)
.Item(a(i, 1))(a(i, 3)) = w
Else
w = .Item(a(i, 1))(a(i, 3))
w(3) = w(3) + a(i, 5)
.Item(a(i, 1))(a(i, 3)) = w
End If
Next
a = Sheets("2015").Range("b2").CurrentRegion.Value
For i = 2 To UBound(a, 1)
If Not .exists(a(i, 1)) Then
Set .Item(a(i, 1)) = _
CreateObject("Scripting.Dictionary")
.Item(a(i, 1)).CompareMode = 1
End If
If Not .Item(a(i, 1)).exists(a(i, 3)) Then
ReDim w(1 To 5)
w(1) = a(i, 1): w(2) = a(i, 3): w(4) = a(i, 5)
.Item(a(i, 1))(a(i, 3)) = w
Else
w = .Item(a(i, 1))(a(i, 3))
w(4) = w(4) + a(i, 5)
.Item(a(i, 1))(a(i, 3)) = w
End If
Next
For Each e In .keys
For Each v In .Item(e).keys
w = .Item(e)(v)
w(5) = w(3) + w(4)
.Item(e)(v) = w
Next
Next
y = .items
End With
'Restitution et mise en forme
Application.ScreenUpdating = False
With Sheets("Feuil1").Cells(1)
.Parent.Cells.Clear
With .Resize(1, 5)
.Value = Array("Nom", "Contrat n°", "2014", "2015", "Total")
.Interior.ColorIndex = 36
.HorizontalAlignment = xlCenter
End With
n = n + .CurrentRegion.Rows.Count
For i = 0 To UBound(y)
With .Offset(n).Resize(y(i).Count, 5)
.Columns(2).NumberFormat = "@"
.Value = _
Application.Transpose(Application.Transpose(y(i).items))
n = n + .Rows.Count + 1
End With
With .Offset(n - 1).Cells(1).Resize(, 5)
.Value = Array("", "Total", _
"=sum(r" & n - y(i).Count & "c:r[-1]c)", _
"=sum(r" & n - y(i).Count & "c:r[-1]c)", _
"=sum(r" & n - y(i).Count & "c:r[-1]c)")
.Interior.ColorIndex = 44
End With
Next
With .CurrentRegion
.Font.Name = "calibri"
.Font.Size = 10
.VerticalAlignment = xlCenter
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
With .Offset(1).Resize(.Rows.Count - 1)
.Columns("c:e").NumberFormat = "#,##0.00"
End With
End With
.Parent.Activate
End With
Application.ScreenUpdating = True
End Sub