Option Explicit
Dim L

Public Function fragmentSeries(p As Integer, k As Long) As Double
    ' N - размерность массива
    ' L - массив
    ' P - количество частей (разбиений, фрагментов)
    ' k - число попыток
    
    Dim i, j, s, m, N, x, jj, minkv, sr, rndr, ss As String
    Dim rr()  ' массив размерностей фрагментов
    Dim minrr() As Integer ' найденный оптимальный массив размерностей фрагментов
    ReDim rr( 2 , p)
    ReDim minrr( 2 , p)
    
    Dim summ() As Double    ' массив сумм фрагментов
    Dim sumr() As Double
    ReDim summ(p)
    ReDim sumr(p)
    
    On Error GoTo errend
    fragmentSeries =  0 
    
    N = UBound(L)
    s =  0 
    For i = LBound(L) To N
        s = s + L(i)
    Next
    sr = s / p
    
    Randomize
    minkv =  9999999999999 #
    For i =  1  To k
        m =  0 
        For j =  1  To p
            rndr = Rnd(Now)
'            Debug.Print rndr
            rr( 1 , j) = m
            If j = p Then
                x = N
            Else
                x = m + Int(rndr * (N - (p - j) - m) +  0 . 5 )
                If x <  0  Then Stop
            End If
            rr( 2 , j) = x
        
            If rr( 2 , j) > UBound(L) Then Stop
        
            s =  0 
            For jj = rr( 1 , j) To rr( 2 , j)
                s = s + L(jj)
            Next
            summ(j) = s
            m = x +  1 
        Next
        s =  0 
        For jj =  1  To p
            s = s + (summ(jj) - sr) ^  2 
        Next
        If s < minkv Then
            For jj =  1  To p
                minrr( 1 , jj) = rr( 1 , jj)
                minrr( 2 , jj) = rr( 2 , jj)
                sumr(jj) = summ(jj)
            Next
            minkv = s
        End If
    Next
    
' Печатаем найденные оптимальные фрагменты ряда
    Debug.Print "Номер", "Лев.гран", "Прав.гран", "Сумма", "Ряд"
    For i =  1  To p
        ss = L(minrr( 1 , i))
            For j = minrr( 1 , i) +  1  To minrr( 2 , i)
            ss = ss & "-" & L(j)
        Next
        Debug.Print i, minrr( 1 , i), minrr( 2 , i), sumr(i), ss
    Next
    Exit Function
errend:
    fragmentSeries = Err.Number
End Function

Sub computate()
    Dim k, t1, t2, p As Integer, m As Long
    L = Array( 1 ,  2 ,  3 ,  7 ,  5 ) 
    t1 = VBA.Timer
    p =  3 
    m =  100000 
    k = fragmentSeries(p, m)
    If k <>  0  Then Debug.Print "Ошибка " & k
    t2 = VBA.Timer
    Debug.Print
    Debug.Print "Время исполнения="; t2 - t1; "сек. Ряд длиной " & UBound(L) +  1  & ", фрагментов " & p & ", попыток - " & m
End Sub


Номер         Лев.гран      Прав.гран     Сумма         Ряд
  1               0               2               6              1 - 2 - 3 
  2               3               3               7              7 
  3               4               4               5              5 

Время исполнения=  1 . 65625  сек. Ряд длиной  5 , фрагментов  3 , попыток -  100000