Sub test()
Dim tab_ref As Object
Set tab_ref = CreateObject("scripting.dictionary")
Sheets("Feuil5").Select
l = 2
While Cells(l, 1) <> ""
ref = Cells(l, 2)
If tab_ref.exists(ref) = False Then tab_ref(ref) = Array(0, 0)
tmp = tab_ref(ref)
qte = Abs(Cells(l, 3))
Select Case Trim(Cells(l, 1))
Case "entrée"
tmp(0) = tmp(0) + qte
Case "sortie"
tmp(1) = tmp(1) + qte
End Select
tab_ref(ref) = tmp
l = l + 1
Wend
'-----------------------------------------------
' ecriture resultat
'-----------------------------------------------
l = 2
For Each cle In tab_ref
Cells(l, 7) = cle
Cells(l, 8) = tab_ref(cle)(0)
Cells(l, 9) = tab_ref(cle)(1)
l = l + 1
Next
End Sub