soustration - différence par dico

Sub es()
  Dim t(), i As Long, m As Object
   Set m = CreateObject("Scripting.Dictionary")
    t = Range("c2:d" & Cells(Rows.Count, 3).End(3).Row)
    For i = 1 To UBound(t)
    If m.Exists(t(i, 1)) Then
    t(m(t(i, 1)), 2) = t(m(t(i, 1)), 2) - t(i, 2)
    Else
    x = x + 1: t(x, 1) = t(i, 1): t(x, 2) = t(i, 2):  m(t(i, 1)) = x
    End If
    Next i
    [i2].Resize(x, 2) = t
End Sub

Sub Test()
Dim Données As Collection, T(), Nom As SsGroup, L As Long
Set Données = GroupOrg(ColUti(Feuil1.[C2:D2]), 1, 2)
ReDim T(1 To Données.Count, 1 To 2)
For Each Nom In Données
   L = L + 1
   T(L, 1) = Nom.Id
   T(L, 2) = Nom.Contenu(Nom.Contenu.Count).Id - Nom.Contenu(1).Id
   Next Nom
Feuil1.[I2].Resize(L, 2).Value = T
End Sub

Sub Test()
Dim Données As Collection, T(), Nom As SsGroup, L As Long
Set Données = GroupOrg(ColUti(Feuil1.[C2:D2]), 1, Null, 2)
ReDim T(1 To Données.Count, 1 To 2)
For Each Nom In Données
   L = L + 1
   T(L, 1) = Nom.Id
   T(L, 2) = Nom.Contenu(Nom.Contenu.Count)(2) - Nom.Contenu(1)(2)
   Next Nom
Feuil1.[I2].Resize(L, 2).Value = T
End Sub

Private Sub CommandButton1_Click()
 Dim Tablo, TabTmp, i As Long, Maxi As Long, Mini As Long, Dico
 Set Dico = CreateObject("Scripting.Dictionary")
 Tablo = Range("C1").CurrentRegion
 For i = LBound(Tablo) + 1 To UBound(Tablo)
    Dico(Tablo(i, 1)) = IIf(Dico.exists(Tablo(i, 1)), Dico(Tablo(i, 1)) - Tablo(i, 2), Tablo(i, 2))
 Next
 Erase Tablo
 Tablo = Application.Transpose(Array(Dico.keys, Dico.Items))
 Range("G1").Resize(Dico.Count, 2) = Tablo
End Sub