Sub SmashToBits(A As Long, N As Integer, pr As Long)
'A - Число, которое надо разбить на части.
'N - Количество частей, на которое надо разбить число А
'Pr - процент отклонения от среднего для случайных чисел  0<Pr<100
Dim Sr, SrOst, Sum1, Ost, Max, Min As Single
Dim i As Integer
Dim ar() As Single
Dim res As String

    ReDim ar(N)
    Sr = A / N                'Среднее значение
    Max = Sr + Sr * pr /  100   'Максимальное отклонение от среднего
    Min = Sr - Sr * pr /  100   'Минимальное отклонение от среднего
    
    Randomize
    Sum1 =  0 
    'Формируем массив случайных чисел с заданным отклонением относительно Максимума
    For i =  0  To N -  1 
        ar(i) = Max -  2  * Rnd * pr /  100  * Sr
        Sum1 = Sum1 + ar(i)
    Next
    'Среднее число от остатка
    SrOst = (A - Sum1) / N
    
    Sum1 =  0 
    'Добавляем среднее от остатка к каждому элементу массива
    For i =  0  To N -  1 
        ar(i) = ar(i) + SrOst
        Sum1 = Sum1 + ar(i)
    Next
    
    'Контроллируем получившуюся сумму.
    'Если она не равна заданной, то разницу добавляем к случайному элементу массива.
    If Sum1 <> A Then
        Ost = A - Sum1
        i = (N -  1 ) * Rnd
        ar(i) = ar(i) + Ost
    End If
    
    Sum1 =  0 
    For i =  0  To N -  1 
        res = res & ar(i) & vbCrLf
        Sum1 = Sum1 + ar(i)
    Next
    Debug.Print res
    Debug.Print Sum1 & " " & Min & " " & Max
End Sub

'Функция округляет числа до указанного количества знаков.
'Если Digits<0, то округление происходит до соотв. разряда целого числа
Public Function MyRound(ByVal N As Single, Optional Digits As Integer =  0 , _
                                     Optional sposob As Integer =  0 )
    'Округляем по правилам
    If sposob =  0  Then
        If Digits >=  0  Then
            'обычное округление десятичных разрядов после запятой
            MyRound = Round(N, Digits)
        Else
            'округдение до десятков, сотен ...
            For i = Digits +  1  To  0 
                N = N /  10 
            Next
            N = Round(N)
            For i = Digits +  1  To  0 
                N = N *  10 
            Next
            MyRound = N
        End If
    'округляем в большую сторону
    Else
        If Digits >=  0  Then
            'округление десятичных разрядов после запятой
            If N > Round(N, Digits) Then
                m =  1 
                For i =  0  To Digits -  1 
                    m = m /  10 
                Next
                MyRound = Round(N, Digits) + m
            Else
                MyRound = Round(N, Digits)
            End If
        Else
            'округдение до десятков, сотен ...
            For i = Digits +  1  To  0 
                N = N /  10 
            Next
            If N <> Int(N) Then
                N = Int(N) +  1 
            End If
            For i = Digits +  1  To  0 
                N = N *  10 
            Next
            MyRound = N
        End If
    End If
End Function

'-------------------------------------------------------------
'A - Число, которое надо разбить на части.
'N - Количество частей, на которое надо разбить число А
'Pr - процент отклонения от среднего для случайных чисел  0<Pr<100
'PlusSr - Абсолютное отклонение от среднего в плюс
'PlusSr - Абсолютное отклонение от среднего в минус
'  можно указать либо процентное отклонение, либо абсолютное в плюс и в минус,
'  если указано абсолютное, то процентное должно быть равно 0!
'Iteration - количество итераций для поиска решения.
Sub SmashToBits(A As Long, N As Integer, _
                ByRef Arr() As Single, _
                Optional pr As Long =  0 , _
                Optional PlusSr As Single =  0 , _
                Optional MinusSr As Single =  0 , _
                Optional Tochnost As Integer =  0 , _
                Optional Iteration As Integer =  100 )
Dim Sr, SrOst, Ost As Single
Dim i, j As Integer
Dim res As String
    
    On Error GoTo errhandler
 
    ReDim Arr(N)
    Sr = A / N                'Среднее значение
    If pr <>  0  Then
        Max = Sr + Sr * pr /  100   'Максимальное отклонение от среднего
        Min = Sr - Sr * pr /  100   'Минимальное отклонение от среднего
    Else
        Max = Sr + PlusSr         'Максимальное отклонение от среднего
        Min = Sr - MinusSr          'Минимальное отклонение от среднего
    End If
    
    Randomize
    j =  1 
    Do
        Sum1 = A
        For i =  1  To N -  1 
            Arr(i) = MyRound((Max - Min) * Rnd + Min, Tochnost)
            'Debug.Print Arr(i)
            Sum1 = Sum1 - Arr(i)
        Next
        Arr(N) = MyRound(Sum1, Tochnost)
        Sum1 = Sum1 - Arr(N)
        If ((Arr(N) < Max) And (Arr(N) > Min)) Then
            Exit Do
        End If
        j = j +  1 
    Loop Until j > Iteration
    If ((Arr(N) > Max) Or (Arr(N) < Min)) Then
        Err.Raise vbObjectError +  513 , "SmashToBits", _
        "Не удалось сформировать нужный массив за  " & j -  1  & " итераций!!!"
    End If
    
    'Sum1 = 0
    'res = ""
    'For i = 1 To N
    '    res = res & Arr(i) & vbCrLf
    '    Sum1 = Sum1 + Arr(i)
    'Next
    'Debug.Print res
    'Debug.Print Sum1 & " " & Min & " " & Max
    'Debug.Print "Количество потребовавшихся итераций = " & j
    
    Exit Sub
    
errhandler:
    MsgBox "Ошибка! " & Chr( 10 ) & Err.Description & Chr( 10 ) & " Номер ошибки " & Err.Number
End Sub