Option Explicit
Sub CountCumulativeNegatives()
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Dim rng As Range
Set rng = ActiveSheet.UsedRange
Dim cnt As Long
cnt = rng.Rows.Count
Dim con As Long
con = 0
Dim loo As Long, lo2 As Long
For loo = 2 To cnt
If Cells(loo, 1).Value < 0 Then
dic.Add key:=loo, Item:=1
If con > 0 Then
For lo2 = con To 1 Step -1
dic(loo - lo2) = dic(loo - lo2) + 1
Next lo2
End If
con = con + 1
Else
dic.Add key:=loo, Item:=0
con = 0
End If
Next loo
Dim key As Variant
For Each key In dic.Keys
' Debug.Print key, ":", dic(key)
Cells(key, 2) = dic(key)
Next key
End Sub