Private Sub Worksheet_Change(ByVal Target As Range)
Dim dLig, dCol, t, i&, n&, r
If Intersect(Range("a:c"), Target) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set dLig = CreateObject("scripting.dictionary"): Set dCol = CreateObject("scripting.dictionary")
Columns("a:a").Copy Columns("e:e")
Columns("e:e").Sort key1:=Range("e1"), order1:=xlDescending, Header:=xlYes
Columns("e:e").RemoveDuplicates Columns:=1, Header:=xlYes
t = Intersect(Range("e:e"), Me.UsedRange).Value2
For i = 2 To UBound(t)
If t(i, 1) <> "" Then If IsNumeric(t(i, 1)) Then dCol(CStr(t(i, 1))) = 1 + dCol.Count
Next i
Columns("b:b").Copy Columns("e:e")
Columns("e:e").Sort key1:=Range("e1"), order1:=xlAscending, Header:=xlYes, MatchCase:=False
Columns("e:e").RemoveDuplicates Columns:=1, Header:=xlYes
t = Intersect(Range("e:e"), Me.UsedRange).Value
For i = 2 To UBound(t)
If t(i, 1) <> "" Then dLig(CStr(t(i, 1))) = 1 + dLig.Count
Next i
ReDim r(1 To dLig.Count, 1 To dCol.Count)
t = Intersect(Range("a:c"), Me.UsedRange).Value2
For i = 2 To UBound(t)
If t(i, 1) <> "" Then
If IsNumeric(t(i, 1)) Then r(dLig(t(i, 2)), dCol(CStr(t(i, 1)))) = r(dLig(t(i, 2)), dCol(CStr(t(i, 1)))) + t(i, 3)
End If
Next i
Range(Range("e1"), Range("e1").End(xlToRight)).EntireColumn.Clear
Range("f1").Resize(, dCol.Count) = dCol.keys
Range("e2").Resize(dLig.Count) = Application.Transpose(dLig.keys)
Range("f2").Resize(UBound(r), UBound(r, 2)) = r
Range("f1").Resize(, dCol.Count).NumberFormat = "dd mmm yyyy"
Range("e1").Resize(dLig.Count + 1, dCol.Count + 1).Borders.LineStyle = xlContinuous
Range("f1").Resize(, dCol.Count).Orientation = 60
Range("e1").Resize(dLig.Count + 1, dCol.Count + 1).EntireColumn.AutoFit
End Sub
