Public Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)

  Dim pivot   As Variant
  Dim tmpSwap As Variant
  Dim tmpLow  As Long
  Dim tmpHi   As Long

  tmpLow = inLow
  tmpHi = inHi

  pivot = vArray((inLow + inHi) \ 2)

  While (tmpLow <= tmpHi)

     While (vArray(tmpLow) < pivot And tmpLow < inHi)
        tmpLow = tmpLow + 1
     Wend

     While (pivot < vArray(tmpHi) And tmpHi > inLow)
        tmpHi = tmpHi - 1
     Wend

     If (tmpLow <= tmpHi) Then
        tmpSwap = vArray(tmpLow)
        vArray(tmpLow) = vArray(tmpHi)
        vArray(tmpHi) = tmpSwap
        tmpLow = tmpLow + 1
        tmpHi = tmpHi - 1
     End If

  Wend

  If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
  If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi

End Sub

    Dim mBootS() As Variant 'Результирующий массив с распределением (перезаписывается для каждого товара)
    Dim mViborkaProd() As Variant 'массив продаж по товару(перезаписывается для каждого товара)
    Dim mBootSViv() 'Этот массив содержит результаты нужных мне процентилей
    ReDim mBootSViv(1 To lRowBase - 1, 1 To 8)

    
    For i = 1 To lRowBase - 1 '(от 1 до 1500 товаров)
        If mBaseFull(i, 8) <> 0 And mBaseFull(i, 8) <> "" Then 'Это ограничение на некоторые виды товаров, которые не имеет смысла обрабатывать (снятые с продаж и т.д.)

            l = 0
            ReDim mViborkaProd(1 To 1)
            For j = 1 To KolDay 'от первого дня периода продаж до последнего
                If mOstDay(i, j) <> "Missing" And mOstDay(i, j) <> 0 And mOstDayPometki(i, j) <> "Days off" Then 'Еще одно ограничение на товары (Не было в продаже, не работал магазин и т.д.)
                    l = l + 1
                    ReDim Preserve mViborkaProd(1 To l)
                    mViborkaProd(l) = Abs(mProdDay(i, j)) 'Где ProdDay(i, j) - это массив продаж
                End If
            Next j

            ReDim mBootS(1 To 10001)
            Randomize 'Не уверен что правильно использую данную функцию
            For k = 1 To 10001
                For j = 1 To 7
                    mBootS(k) = mBootS(k) + mViborkaProd(Int((l * Rnd) + 1)) 'сумма сгенерированных продаж за неделю (сами дни не нужно хранить, интересует только сумм)
                Next j
            Next k
           
            SortArray mBootS, True 'Сортирую массив
          'Извлекаю только интересующие меня процентили во всем распределении, остальное потом будет перезаписано
            mBootSViv(i, 1) = mBase(i, 1) '
            mBootSViv(i, 2) = mBootS(1000) 'Мин
            mBootSViv(i, 3) = mBootS(750) '25%
            mBootSViv(i, 4) = mBootS(500) '50%
            mBootSViv(i, 5) = mBootS(200) '80%
            mBootSViv(i, 6) = mBootS(100) '90%
            mBootSViv(i, 7) = mBootS(50) '95%
            mBootSViv(i, 8) = mBootS(1) '100%

        End If
    Next i
 

For i = 16 To lColumnsCnt 
.Range(.Cells(3, i), .Cells(lLastRow_Prod_Un_C, i)).FormulaArray = .Range(.Cells(3, i), .Cells(lLastRow_Prod_Un_C, i)).Formula 
Next i 

'Нахожу последний столбец / строку:
lColumnsCnt = wSh_Base_Sales.Cells(1, wSh_Base_Sales.Columns.Count).End(xlToLeft).Column
lLastRow_Prod_Un_C = wSh_Base_Sales.Cells(Rows.Count, 13).End(xlUp).Row


With wSh_Base_Sales
'Копирую формулы в весь диапозон
.Range(.Cells(3, 16), .Cells(lLastRow_Prod_Un_C, lColumnsCnt)).Formula = .Range(.Cells(2, 16), .Cells(2, lColumnsCnt)).Formula
For i = 16 To lColumnsCnt
'Преобразую формулы в массивы
.Range(.Cells(3, i), .Cells(lLastRow_Prod_Un_C, i)).FormulaArray = .Range(.Cells(3, i), .Cells(lLastRow_Prod_Un_C, i)).Formula
Next i
.Calculate
End With

wSh_Base_Sales.Range("P3:Q" & lLastRow_Prod_Un_C).Formula = wSh_Base_Sales.Range("P2:Q2").Formula
wSh_Base_Sales.Range("P3:P" & lLastRow_Prod_Un_C).FormulaArray = wSh_Base_Sales.Range("P3:P" & lLastRow_Prod_Un_C).FormulaR1C1
wSh_Base_Sales.Range("Q3:Q" & lLastRow_Prod_Un_C).FormulaArray = wSh_Base_Sales.Range("Q3:Q" & lLastRow_Prod_Un_C).FormulaR1C1