Спасибо за совет, я так и сделал. После 6 часов разборки, понял, что проблема была в сортировке. Проверил около 10 вариантов и самый быстрый оказался этот, скорость выросла с 215 сек до 1 сек. Мне нужно было сортировать числа.
Код
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
Работает очень быстро и хорошо сортирует по возрастанию числа (про остальное не знаю). И еще что касается скорости: до этого (с пузырьковой сортировкой), считал для 1000 генераций 190 сек. Сейчас для 10000 генераций считает 40 сек.
И еще у меня идет перебор по одному, может как то надо заранее создать таблицы случайных чисел, а потом по ним пройтись циклом. ____ Хотя, я так уже делал. Основной тормоз видимо в выдергивании случайных чисел из одного массива и добавление в другой массив с операцией сложения и сортирования.
Спасибо, сделал. Тестирую для выборки в 1000 штук. Было 195 сек, стало 187. Мне вот просто интересно у кого сколько подобные операции занимают времени. 1500 * 10000 операций. А Randomize правильно использован?
Здравствуйте. Тестирую метод бутстрапа на примере продаж товаров. В общем что хочу получить на выходе: У меня есть массив продаж за определенный период (Сейчас около 1500 товаров). Есть еще массив остатков на складе. Я хочу взять каждый товар, вычленить массив продаж, но только с условием что товар был на складе (там еще есть пара условий, но не суть), далее сгенерировать 10000 недель случайных продаж товара на основе существующей истории. Во всей этой ситуации есть проблема: скорость обработки и генерации 10000 (хотя бы) строк по 1500 товарам занимает почему то огромное количество времени (10 сек на 1 товар).
Если кто то сталкивался с задачей, может есть методы ускорить код. Привожу код ниже с комментариями.
Код
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
Интересует задача оптимизации с помощью надстройки "Поиск решения линейных задач симплекс-методом". В ней есть одна большая проблема - ограничения условий 200 штук. Мне необходимо на 3000 условий (Оптимизация товаров). Если кто сталкивался, можно ли преодолеть его с помощью VBA или другой (аналогичной) надстройки?
The_Prist спасибо, заработало. Утро вечера мудренее оказалось, не заметил, что делаю полный бред. У меня видимо ошибка в чем-то еще, так как попробовал в другом файле, все работает, у меня нет. Буду искать подвох.
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
Здравствуйте. Возникла, казалось бы простая задача, растянуть формулу массива до конца последней строки, но по какой то причине это не выходит. Делал так. В Range("P2: Последняя строка / столбец") у меня имеются формулы ({массивы}). Я прочитал на форумах, что за вставку массивов отвечает не formula / formular1c1, а FormulaArray. Растягивать нужно в "P3: последняя строка/столбец"
Код
'Нахожу последний столбец / строку:
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
Вся это конструкция не работает. Я не понимаю почему, особенно если учитывать что
работает без проблем Ситуация с Range("A1:A2") и Range(Cells (1,1), Cells(1,2)) должна быть одинаковой (так везде в примерах приведено), но у меня это не работает и всегда выдает ошибку.
Здравствуйте. Не нашел нигде решение задачи. Дело в том, что при копировании текста (selection.value=selection.value) у меня пропадают нули перед кодами (было 00154 стало 154). И тут два варианта копировать как текст правильно, но я не знаю как или добавить нули опять. Хорошего решения я не нашел. Как преобразовать формат текста в нужный (0000000) и сохранить его как текст? Как правильно копировать подобные значения? Может кто при помощи VBA выставлял такие форматы текста? Интересует только VBA вариант. Range().NumberFormat = "000000" - выдает число с нулем перед ним, но это не одно и тоже. Как сделать сохранение как текст, не пойму.
Спасибо JayBhagavan, работает. Есть еще вопрос по копированию цифр. Дело в том, что при копировании (selection.value=selection.value) у меня пропадают нули перед кодами (было 00154 стало 154). И тут два варианта копировать как текст, но я не знаю как или добавить нули опять. Хорошего решения я не нашел, кроме такого: Format( n, "000000"), но я не понял как им пользоваться. Может кто при помощи VBA выставлял такие форматы текста?
Здравствуйте. Столкнулся со следующей проблемой. В Exel с помощью макроса выгружаю массив данных - продажи за период (Около 5000 строк). Далее макрос растягивает формулы рядом с этим массивом. Получается довольно тяжеловесный массив. Авто пересчет я отключать не хочу, поэтому хочу просто по выполнению расчета копировать массив с формулами и вставлять значения (Они мне в дальнейшем не нужны все равно). Все было бы хорошо, но массив не успевает рассчитать значения, а макрос уже его копирует и получается на выходе ничего хорошего. Если кто то сталкивался с подобным, как все таки начать копирование после выполнения пересчета страницы? Еще одно замечание - некоторые формулы массива также являются функциями (макросами).