=СУММПРОИЗВ(--ЛЕВБ(ПРАВБ(ПОДСТАВИТЬ(ПОДСТАВИТЬ("0;"&D3;"(!)";";0");";";ПОВТОР(" ";99));99*СТРОКА($1:$99));99))

=СУММПРОИЗВ(--ТЕКСТ(ЛЕВБ(ПРАВБ(ПОДСТАВИТЬ(ПОДСТАВИТЬ("0;"&D3;"(!)";";0");";";ПОВТОР(" ";99));99*СТРОКА($1:$99));99);"[<5];0,000;\0;\0"))

Sub u_700()
    Application.ScreenUpdating = False
    c = Cells(Rows.Count, "d").End(xlUp).Row
    For Each d In Range("d3:d" & c)
        f = d.Address
        'все
        h = Replace(Replace(Replace(d, "(!)", ""), ",", "."), ";", "+")
        j = Evaluate(h)
        d.Offset(0, 1) = j
        'красные
        e = Len(d)
        x = ""
        For i = 1 To e
            u = Range(f).Characters(Start:=i, Length:=1).Font.ColorIndex
            v = Mid(d, i, 1)
            If u = 3 Or v = ";" Then
                If v = ";" Then v = "+"
                x = x & v
            End If
        Next i
        a = Replace(Replace(x, "(!)", ""), ",", ".")
        b = Evaluate(a)
        g = Application.IsNumber(b)
        If g Then d.Offset(0, 2) = b
        '<5
        k = d & ";"
        l = Len(k)
        m = Replace(k, ";", "")
        n = Len(m)
        o = l - n
        r = ""
        For p = 1 To o
            q = InStr(k, ";")
            s = Replace(Mid(k, 1, q - 1), "(!)", "")
            If s >= 5 Then s = ""
            r = r & "+" & s
            k = Mid(k, q + 1, l)
        Next p
        aa = Replace(r, ",", ".")
        ab = Evaluate(aa)
        ac = Application.IsNumber(ab)
        If ac Then d.Offset(0, 3) = ab
    Next
    Application.ScreenUpdating = True
End Sub