Option Explicit
Sub test()
Dim a, i As Long, n As Long, y, e, w, s
a = Sheets("2014").Range("a1").CurrentRegion.Resize(, 3).Value
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 1 To UBound(a, 1)
a(i, 1) = CStr(a(i, 1)): a(i, 2) = CStr(a(i, 2))
If Not .exists(a(i, 1)) Then
Set .Item(a(i, 1)) = _
CreateObject("Scripting.Dictionary")
.Item(a(i, 1)).CompareMode = 1
End If
.Item(a(i, 1))(a(i, 2)) = _
VBA.Array(a(i, 1), a(i, 2), a(i, 3), Empty, Empty)
Next
a = Sheets("2015").Range("a1").CurrentRegion.Resize(, 3).Value
For i = 1 To UBound(a, 1)
a(i, 1) = CStr(a(i, 1)): a(i, 2) = CStr(a(i, 2))
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, 2)) Then
.Item(a(i, 1))(a(i, 2)) = _
VBA.Array(a(i, 1), a(i, 2), Empty, a(i, 3), Empty)
Else
w = .Item(a(i, 1))(a(i, 2))
w(3) = a(i, 3)
.Item(a(i, 1))(a(i, 2)) = w
End If
Next
For Each e In .keys
For Each s In .Item(e).keys
w = .Item(e)(s)
w(4) = w(3) - w(2)
.Item(e)(s) = w
Next
Next
y = .items
End With
'Restitution et mise en forme
Application.ScreenUpdating = False
With Sheets("Feuil1")
n = 1
.Cells.Clear
.Columns("b").NumberFormat = "@"
With .Cells(1)
.Resize(1, 5).Value = Array("Comptes", "Account", "2014", "2015", "Variation")
For i = 0 To UBound(y)
With .Offset(n).Resize(y(i).Count, 5)
.Value = _
Application.Transpose(Application.Transpose(y(i).items))
n = n + .Rows.Count
End With
Next
With .CurrentRegion
.Font.Name = "calibri"
.Font.Size = 10
.VerticalAlignment = xlCenter
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
With .Offset(1).Resize(.Rows.Count - 1)
.Columns("c:e").NumberFormat = _
"_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
End With
With .Rows(1)
.BorderAround Weight:=xlThin
.Interior.ColorIndex = 38
.HorizontalAlignment = xlCenter
End With
.Columns.AutoFit
End With
End With
.Activate
End With
Application.ScreenUpdating = True
End Sub