Друзья, привет. Нужна Ваша помощь, есть код для расчёте математической модели, расчёт занимает от 10 до 30 минут, в зависимости от кол-во вводных данных. Через форум нашёл прогресс бар, но когда "вкорячил" свой код в данный статус бар появились "приключения"
Код расчёта:
Скрытый текст
Код
Public Sub RecalculateFTECoefs()
Dim wAnal As Worksheet
Dim wMacros As Worksheet
Dim lr As Long
Dim lAllCnt As Long 'кол-во итераций
Const lMaxQuad As Long = 20 'сколько квадратов выводить
lAllCnt = 10000
Dim I As Long
Dim S As String
Dim iStoreRow As Long
Dim currentStore As Integer
Dim iMacrosFirstSectionRow As Long
Dim iSection As Long
Dim SectionName As String
Dim iMacrosSectionRow As Long
Dim iAnalFirstSectionCol As Long
Dim iAnalLastSectionCol As Long
Dim iAnalSectionHeaderRow As Long
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
' закладка "расписание"
Set wAnal = ThisWorkbook.Worksheets("Аналитика")
Set wMacros = ThisWorkbook.Worksheets("Для макроса")
' строка первой секции
iMacrosFirstSectionRow = Range("Для_макроса_список_секций").Row
'строка заголовка секций
iAnalSectionHeaderRow = Range("Аналитика_первая_колонка_секций").Row
' колонка первой секции
iAnalFirstSectionCol = Range("Аналитика_первая_колонка_секций").Column
' ищем колонку последней секции
iAnalLastSectionCol = 1000
Do
If wAnal.Cells(iAnalSectionHeaderRow, iAnalLastSectionCol) <> "" Then Exit Do
iAnalLastSectionCol = iAnalLastSectionCol - 1
Loop
iStoreRow = Range("Аналитика_список_магазинов").Row
Do
' цикл по магазинам
' берем очередной магазин
currentStore = Val(Worksheets("Аналитика").Cells(iStoreRow, 1))
If currentStore = 0 Then Exit Do
Debug.Print "Магазин: " & currentStore
' выбираем магазин и пересчитываем всё
Range("номер_магазина") = currentStore
Calculate
iSection = 1
Do
' цикл по секциям
iMacrosSectionRow = iMacrosFirstSectionRow + iSection - 1
' название секции
SectionName = wMacros.Cells(iMacrosSectionRow, 1)
If SectionName = "" Then Exit Do
Debug.Print " Секция '" & SectionName & "'"
' ищем на листе Аналитика первую колонку нужной секции
I = iAnalFirstSectionCol
Do
' берем заголовок секции
S = wAnal.Cells(iAnalSectionHeaderRow, I)
If S = "" And I > iAnalLastSectionCol Then
MsgBox "Секция '" & SectionName & "' на закладке 'Аналитика' не найдена!"
Exit Sub
End If
If S = SectionName Then Exit Do
I = I + 1
Loop
' нашли колонку секции
' копируем значения
wAnal.Cells(iStoreRow, I + 1) = wMacros.Cells(iMacrosSectionRow, 2 + 1)
wAnal.Cells(iStoreRow, I + 2) = wMacros.Cells(iMacrosSectionRow, 2 + 2)
wAnal.Cells(iStoreRow, I + 3) = wMacros.Cells(iMacrosSectionRow, 2 + 3)
wAnal.Cells(iStoreRow, I + 4) = wMacros.Cells(iMacrosSectionRow, 2 + 4)
wAnal.Cells(iStoreRow, I + 5) = wMacros.Cells(iMacrosSectionRow, 2 + 5)
wAnal.Cells(iStoreRow, I + 6) = wMacros.Cells(iMacrosSectionRow, 2 + 6)
For lr = 1 To lAllCnt
Application.StatusBar = "Выполнено: " & Int(100 * lr / lAllCnt) & "%" & String(CLng(lMaxQuad * lr / lAllCnt), ChrW(9632)) & String(lMaxQuad - CLng(lMaxQuad * lr / lAllCnt), ChrW(9633))
DoEvents
Next
iSection = iSection + 1
Loop
iStoreRow = iStoreRow + 1
Loop
Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Код Статус Бара
Скрытый текст
Код
Sub ПростойПример1()
КоличествоЗапусковВнешнегоМакроса = 3000
Dim pi As New ProgressIndicator ' создаём новый прогресс-бар
pi.Show "Форматирование ячеек" ' отбражаем индикатор
' первое действие (на шкале индикатора от 0 до 95 процентов) - это окраска ячеек
pi.StartNewAction 0, 95, "Окраска ячеек", , , КоличествоЗапусковВнешнегоМакроса
' цикл с вызовом внешнего макроса "ФорматированиеЯчейки"
For I = 1 To КоличествоЗапусковВнешнегоМакроса
' инициируем очередное действие в индикаторе
pi.SubAction , "Обрабатывается ячейка $index из $count", "$time"
' собственно, код цикла
RecalculateFTECoefs
Next
' всё покрасили - теперь пора чистить ячейки )
pi.StartNewAction 95, 100, "Очистка ячеек"
Cells.Clear
pi.Hide ' закрываем индикатор
End Sub
В оригинале было:
Скрытый текст
Код
' собственно, код цикла
ФорматированиеЯчейки i
Next
Но когда добавляю переменную вылетаеть ошибка: "Wrong number of arguments or invalid property assigment" Без данного аргумента статус бар работает, но считает оригинальный макрос в 4 раза дольше.
Помогите, что делать нет не понимаю, все работает, но нереально долго ....
Даниэль, у Вас в коде расчета уже есть вывод в статусбар, 105 строка. Зачем прикручивать еще внешний класс? И зачем этот вывод повторять в цикле lAllCnt раз?!
А лучше оптимизировать код, чтобы ускорить его на порядок, тогда и статусбар будет неактуален. Для этого нужен файл-пример и словесное описание алгоритма.
Там, откуда Вы взяли пример вывода в StatusBar я вроде неплохо расписал в каких случаях и как правильно выводить информацию. У Вас циклы Do, которые не имеют четкой конечной границы и поэтому статус-бар можно использовать только для показа, что что-то вообще делается. Но в процентах это сделать не получится, чтобы нормально показывало. Почитайте более внимательно и с самого начала: Отобразить процесс выполнения кода
Чисто теоретически здесь:
Код
For lr = 1 To lAllCnt
Application.StatusBar = "Выполнено: " & Int(100 * lr / lAllCnt) & "%" & String(CLng(lMaxQuad * lr / lAllCnt), ChrW(9632)) & String(lMaxQuad - CLng(lMaxQuad * lr / lAllCnt), ChrW(9633))
DoEvents
Next
iSection = iSection + 1
Loop
iStoreRow = iStoreRow + 1
Казанский написал: у Вас в коде расчета уже есть вывод в статусбар, 105 строка.
Забыл совсем про этот статус бар, он не корректно работает, он работает после каждого цикла, но не отображает весь процесс, просто пробегает внизу от начала до конца и стартует верхний цикл.
Казанский написал: А лучше оптимизировать код, чтобы ускорить его на порядок, тогда и статусбар будет неактуален. Для этого нужен файл-пример и словесное описание алгоритма
Сегодня вечером постараюсь сделать шаблон файла с описанием кода.
как-то я сомневаюсь, что отображение статус-бара один раз в цикле вместо For lr = 1 To lAllCnt раз замедлило работу. Где-то Вы косячите даже не вдумываясь в смысл происходящего и того, что делаете сами.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Казанский написал: А лучше оптимизировать код, чтобы ускорить его на порядок, тогда и статусбар будет неактуален. Для этого нужен файл-пример и словесное описание алгоритма.
Макрос должен делать: Необходимо поочерёдно подставить номера магазинов, указанных в столбце A (в среднем расчёт идет на 450 магазинов) (начиная с ячейки А9) листа "Аналитика" в ячейку D1 листа "Параметры" и вывести данные из листа "Для макроса" в лист "Аналитика" в столбцы с указанием "Макрос" (в строке 8 ) начиная с 9 строки. В качестве примера в строке 9 приведены ссылки на ячейки из которых нужно забрать данные.