Calcoli senza colonne di supporto,

Sub VBA()
Dim I As Integer, K As Integer, ArrIKLM() As Double, arrAppo() As Double
Dim lr As Long, Idx As Integer, T As Double, T1 As Double, mMax As Double
Range("K2:M2").ClearContents
Range("I6:I39").ClearContents
Range("K6:M39").ClearContents
lr = Range("B" & Rows.Count).End(xlUp).Row
ReDim ArrIKLM(1 To lr - 5, 1 To 4) 'colonna I-K-L-M
ReDim arrAppo(1 To 1) ' serve per simulare dati formula colonna L
Idx = 1
For I = 6 To lr
    If Cells(I, 3) >= Cells(2, 7) And Application.WorksheetFunction.Sum(Range(Cells(I, 3), Cells(I, 6))) <= Cells(2, 8) Then
        If Cells(I, 6) - Cells(I, 4) <= Cells(2, 9) Then
            ArrIKLM(Idx, 1) = Cells(I, 2)
        Else
            ArrIKLM(Idx, 1) = 0
        End If
    End If

    If ArrIKLM(Idx, 1) = 1 Then
        ArrIKLM(Idx, 2) = Cells(2, 6) * (Cells(I, 10) - 1)
    ElseIf ArrIKLM(Idx, 1) = 0 Then 'Cells(I, 9) = 0 Then
        ArrIKLM(Idx, 2) = -Cells(2, 6)
    End If
    T = T + ArrIKLM(Idx, 2)
    ArrIKLM(Idx, 3) = T
    If I = 6 Then
        ArrIKLM(Idx, 4) = 0
        arrAppo(Idx) = ArrIKLM(Idx, 3)
    Else
        If mMax - ArrIKLM(Idx, 3) < 0 Then
            ArrIKLM(Idx, 4) = 0
            arrAppo(Idx) = ArrIKLM(Idx, 3)
        Else
            ArrIKLM(Idx, 4) = mMax - ArrIKLM(Idx, 3)
            arrAppo(Idx) = ArrIKLM(Idx, 3)
        End If
    End If
    Idx = Idx + 1
    mMax = Application.WorksheetFunction.Max(arrAppo())
    ReDim Preserve arrAppo(1 To Idx)
Next I
'Range("W6").Resize(UBound(ArrIKLM), 4) = ArrIKLM se togli l'apice verrà stampato da W in poi l'array contenente i valori delle tue IKLM ormai soppresse

With Application.WorksheetFunction
    Cells(2, 11) = .Sum(.Index(ArrIKLM, 0, 2))
    Cells(2, 12) = .Max(.Index(ArrIKLM, 0, 4))
    Cells(2, 13) = Cells(2, 11) / Cells(2, 12)
End With
End Sub