подсчитать количество и сумму положительных и отрицательных чисел которые идут подряд

[Ascomos]

Добрый вечер. Помогите пожалуйста. Необходимо чтобы все расчеты выполнялись в макросе и выводились только значения подсвеченные желтым.Зарание спасибо.7528693.xlsx

[AlexM12]

Сообщение от Ascomos

Необходимо чтобы все расчеты выполнялись в макросе и выводились только значения подсвеченные желтым

Какие расчеты, куда выводились. Про цвета не пишите, пишите чем эти значения отличаются от других.
И главное, в файле надо показать, что хотите получить.

[Aleksandr H.]

Sub a()
    Dim posS, posC, negS, negC, r
    Dim ps, pc, ns, nc
    r = 2
    Do While Cells(r, "D") <> ""
        If Cells(r, "D") > 0 Then
                posC = posC + 1: negC = 0: negS = 0
                posS = posS + Cells(r, "D")
               If pc <= posC And ps < posS Then
                    pc = posC: ps = posS
               End If
            
        ElseIf Cells(r, "D") < 0 Then
                negC = negC + 1: posC = 0: posS = 0
                negS = negS + Cells(r, "D")
               If nc <= negC And ns > negS Then
                    nc = negC: ns = negS
               End If
        End If
        r = r + 1
    Loop
    [k4] = ps: [k5] = pc
    [j4] = ns: [j5] = nc
End Sub

[Ascomos]

Александр агромное спасибо .