Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Оптимизация макроса, Ускорение работы макроса
 
Приветствую знатоков макросов. Нужна помощь по оптимизации макроса.
Нижеследующий макрос выполняет задачу за 4 минут. Нужно сократит время работы макроса до минуты (желательно до нескольких секунд).
Код
Sub InputData()
FastBegin 'отключаем свойства для быстродействия'
ThisWorkbook.Unprotect

    Dim LastRow As Long
    With Sheets("ФОРМА 2")
    .Unprotect
    .Range("B13:G20000").MergeCells = False
    .Range("AB13:AG20000").Formula = .Range("AB13:AG13").Formula
    .Range("B14:G20000").Value = .Range("AB14:AG20000").Value
    .Range("AB14:AG20000").ClearContents
    .Range("E2").Value2 = "ДАТА"
    .Range("Y13:Y20000").Formula = .Range("Y13").Formula
    .Range("Y14:Y20000").Value = .Range("Y14:Y20000").Value
    .Range("Y14:Y20000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    .Range("I:I").EntireColumn.Hidden = False
    .Shapes.Range(Array("Rectangle 6", "Rectangle 7", "Rectangle 12", "Rectangle 13", "Rectangle 14", "Rectangle 15")).Visible = msoTrue
    LastRow = .Cells(Rows.Count, "Y").End(xlUp).Row
    .Range("B14:X" & LastRow).Borders.Weight = xlHairline
    .Range("B14:X" & LastRow).Font.Name = "Arial Narrow"
    .Range("B14:X" & LastRow).VerticalAlignment = xlCenter
    .Range("B14:X" & LastRow).Font.Size = 10
    .Range("B14:X" & LastRow).Font.Color = RGB(0, 0, 0)
    .Range("B14:U" & LastRow).Font.Bold = False
    .Range("B14:X" & LastRow).Font.Italic = False
    .Range("B14:X" & LastRow).Font.Underline = xlUnderlineStyleNone
    .Range("B14:X" & LastRow).Interior.Pattern = xlNone
    .Range("B14:E" & LastRow).HorizontalAlignment = xlCenter
    .Range("D14:D" & LastRow).HorizontalAlignment = xlLeft
    .Range("F14:G" & LastRow).NumberFormat = "#,##0.000"
    .Range("F14:W" & LastRow).HorizontalAlignment = xlRight
    .Range("H14:I" & LastRow).NumberFormat = "#,##0"
    .Range("I13:W" & LastRow) = Range("I13:W13").Formula
    .Range("AA14:AG" & LastRow) = Range("AA12:AG12").Formula
    .Range("X14:X" & LastRow).Interior.Color = RGB(218, 238, 243)
    If CheckBox1.Value = True Then .Range("H13:H" & LastRow) = Range("H13").Formula
    
    Dim i As Long, r3 As Range, r4 As Range, r5 As Range, r6 As Range
    For i = 14 To 20000
    Set r3 = Range("Y" & i)
    Set r4 = Range("B" & i & ":U" & i)
    Set r5 = Range("D" & i)
    Set r6 = Range("H" & i & ":U" & i)
    If r3.Value = 1 Then r4.Interior.Color = vbYellow
    If r3.Value = 1 Then r4.Font.Size = 14
    If r3.Value = 1 Then r4.HorizontalAlignment = xlLeft
    If r3.Value < 3 Then r4.Font.Bold = True
    If r3.Value = 1 Then r4.WrapText = False
    If r3.Value = 3 Then r4.Font.Color = RGB(128, 0, 128)
    If r3.Value = 5 Then r4.Font.Color = RGB(0, 0, 128)
    If r3.Value = 1 Then r6.ClearContents
    Next i
    .Range("B14:H30000, T14:T30000, X14:X30000").Locked = False
    .Rows("14:20000").EntireRow.AutoFit
    End With

    Sheets("ИТОГ").Rows("2:47").Copy
    Range("Y" & Rows.Count).End(xlUp).Select
    Rows(ActiveCell.Row).Offset(1, 0).ACTIVATE
    ActiveSheet.Paste
    Range("Z13:Z20000").Formula = Range("Z13:Z13").Formula
    Range("Z14:AA20000").Value = Range("Z14:AA20000").Value
    If CheckBox1.Value = True Then Sheets("РЕСУРС").Visible = True
    Sheets("ФОРМА 3").Visible = True
    Sheets("ФОРМА 4").Visible = True
    Sheets("ФОРМА 2").Protect AllowFormattingCells:=True, AllowFiltering:=True
    ThisWorkbook.Protect
FastEnd 'включаем свойства'
End Sub
Формулы на листе очень простые и они не замедляют макрос. Цикл For i = 14 To 20000 который форматирует условные ячейки, замедляет макрос на 1 минуту. Без него макрос работает 3 минуты, но форматирование обязательно нужно.

Мне сказали, что не все специалисты охотно берутся за оптимизацию макросов, но я надеюсь кого-нибудь эта работа заинтересует.
Если кто-нибудь сможет выполнить этот заказ, могу отправить сам файл с макросом на почту.

С Уважением
Изменено: sherzodom - 6 Апр 2020 23:38:46
 
написал в личку

зы.
И. да... e-mail должен быть в профиле; выкладывать личные данные в теме запрещено правилами форума - удалите.
Изменено: Михаил Витальевич С. - 6 Апр 2020 22:27:49
 
sherzodom, и код следует оформлять соответствующим тегом. Ищите такую кнопку (см. скрин) и исправьте своё сообщение.
Тег VBA.jpg (19.2 КБ)
 
Первый раз делаю пост. Спасибо за исправления.
 
А как так получилось, что мне на почту пришли эти два письма с ссылкой на этот пост?  
В жизни нет ничего невозможного! Есть только недостаток знаний и умений.
 
Александр, Я сам отправил ссылку на свой пост по некоторым адресам, по которым были положительные отзывы... (подумал, вдруг не скоро зайдут сюда).
 
Заказ свободен.
Я не вижу путей оптимизации на столько, как просит ТС.
 
Михаил Витальевич С., здравствуйте! Узкое место вы нашли?
Это всегда та строка, которая по Shift+F8 тупит больше других.

sherzodom, если проблему не решили, обращайтесь, ЛС просматриваю иногда...
 
Апострофф, доброго здоровья; и всем тоже - доброго здоровья!
Я нашел, как мне кажется, несколько мест, где явно можно ускорить. Но такую прибавку не даст.
Да, и, на моем компе макрос отрабатывает примерно за минуту-полторы (таймером не проверял), так что....
 
А с чем там тормоза связаны? С шейпами, закраской ячеек, каким то форматированием, ещё чем то? Я не вижу отсюда, прошу прощения :oops:  
 
Цитата
Апострофф написал:
А с чем там тормоза связаны?
ну, если на макрос в первом сообщении посмотреть, то строки с 8 по 35 - форматирование диапазонов; но здесь я и не вижу, как можно ускорить;
и строки 39-52; здесь в цикле форматируются 20 000 ячеек, по одной - вот здесь можно ускорить, собрав в диапазоны.
Макрос в файле немного отличается от показанного и там есть еще пара узких мест подобного типа.
 
Если можно то хочу посмотреть, не ради работы, а ради интереса, на мой взгляд даже мелкие стилистические вещи могут дать оптимизацию.
По вопросам из тем форума, личку не читаю.
 
Цитата
sherzodom написал:
Формулы на листе очень простые и они не замедляют макрос.
Вставлю свои пять копеек. Возможно не прав.
Недавно свой код оптимизировал. Дело не в сложности формул, а в том, что Excel после каждой вставки/изменении формулы производит проверку всей таблицы на предмет зависимостей и пересчитывает зависимые ячеки, вот на этом моменте и тормозит. Если отключить авто пересчет, то Excel будет в памяти составлять дерево зависимостей без пересчета и процесс пойдет несколько быстрее. Потом надо включить автопересчет и все изменения будут пересчитаны скопом.
Изменено: Joiner - 8 Апр 2020 09:30:21
Никому не отвечай, кoгда ты зол, ничего не обeщай, когда ты счастлив, никогда нe решай, когда ты грустeн.
 
Joiner,  это не основная ветка + нужно читать код
Код
 FastBegin 'отключаем свойства для быстродействия'
прежде чем писать
По вопросам из тем форума, личку не читаю.
 
Joiner, авто пересчет и все остальное, что можно отключить, там отключается отдельным макросом. Вставка формул почти не влияет на время работы.
Цитата
БМВ написал:
Если можно то хочу посмотреть, не ради работы, а ради интереса,
Миш, обращайся к ТС напрямую; я вроде как не имею права, хоть ничего секретного в файле нет, на мой взгляд.
Просто он 3 М весит.
 
Цитата
БМВ написал:
Joiner ,  это не основная ветка + нужно читать код Код ? 1FastBegin 'отключаем свойства для быстродействия' прежде чем писать
А я должен угадать что это? В примере кода этой процедуры/функции нет, как и FastEnd.

А общий посыл моего поста в том что "макрос + формулы = тормоза". И вряд ли что-то кардинально поможет.
Изменено: Joiner - 8 Апр 2020 10:31:41
Никому не отвечай, кoгда ты зол, ничего не обeщай, когда ты счастлив, никогда нe решай, когда ты грустeн.
 
Joiner, Еще раз, это не основная ветка и решения тут не публикуются. Не знаю как остальные, но я считаю что тут можно дать комментарии, которые позволяют лучше понять или пояснить задачу, что позволяет быстрее, точнее найти исполнителя, даже если это сам ТС, но не обсуждать решение.
Да и общий смыcл посыла "макрос + формулы = тормоз" - не верен. Хотите поспорить  то в ветке курилка.
По вопросам из тем форума, личку не читаю.
 
из моего опыта:
в любой задаче отчеты должны быть отделены от данных любая попытка совмещения - ошибка
формулы в данных - недопустимы, только чистые данные, если что-то нужно преобразовывать - макрос: пользователь ввел значение, макрос растолкал по соседним ячейкам результаты вычислений
тут 20 тыс.строк, если там одна колонка с формулами их уже 20 тыс. шт., а если несколько? умножаем на 2,3 ...
до 1000 формул - вообще не заметно
до 5000 - могут появиться подозрения, что что-то тут вычисляется
20тыс. и более - будьте готовы подождать пару секунд, пару десятков секунд, пока Excel пересчитает их все, потому что пользователь что-то изменил в какой-то одной ячейке
не принимайте все сказанное за абсолютные истины, формулы формулам рознь, у компьютеров разная производительность (вычислительная мощь), но приблизительно это работает так, и если вы пошли по пути наращивания количества формул в документе, то будьте готовы к тому, что на каком-то этапе реальность заставит вас задуматься как свернуть с этой дорожки, чтобы не палить нервы каждый раз ,когда из ячейки вы вышли не ESCом, а ENTERом

и вообще, эта ветка не для обсуждения задачи
Изменено: Ігор Гончаренко - 8 Апр 2020 10:54:59
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
БМВ написал:
Да и общий смыcл посыла "макрос + формулы = тормоз" - не верен.
В данном случае - согласен.
Можно, конечно, все вычислять макросом, но кроме мороки с кодом это ни чего не даст.
Цитата
Ігор Гончаренко написал:
и вообще, эта ветка не для обсуждения задачи
Изменено: Михаил Витальевич С. - 8 Апр 2020 11:11:57
 
Давайте прекращать обсуждение. Не тот раздел.
 
Добрый день уважаемые,

Спасибо за проявленный интерес к этой задаче. Написали несколько специалистов, кто-то отказал, кто-то не отвечает и кто-то предложил написать новый макрос, и вопрос всё еще актуален.

Протестировал файл внося некоторые изменения. Убрал все листы из файла кроме текущей, где работает макрос, время работы макроса сократилось на 1 мин., хотя связи с другим листами в этом макросе нет, разве только 3 скрытых листа показывает (.Visible = True). Получается в уменьшенном файле макрос работает быстрее? Не понятно.

Также, цикл For i = 14 To 20000 замедляет на 1 минуту, но заменить его не получается. Хотел в макросе убрать этот цикл и применить Условное форматирование, но перед запуском этого макроса, предварительно очищается рабочая область, и тогда УФ исчезает.

Наверное, лучше будет написать новый макрос, который будет выполнять задачу в памяти и реально быстрее работать. Я попробую написать ТЗ, и файл который уже есть показывает какой результат нужен.

Если этот макрос(он самый медленный) получится создать как хотелось бы, на очереди есть еще пару макросов из этого же файла. Опытный пользователь используя шаблон и применяя несколько формул может выполнять этот же отчёт значительно быстрее чем этот файл, поэтому без быстрых макросов файл не так полезен.

Жду положительных результатов.
Спасибо.
 
Цитата
Михаил Витальевич С. написал:
Да, и, на моем компе макрос отрабатывает примерно за минуту-полторы (таймером не проверял), так что....
Полтора минуты, хороший результат. Может сможете еще немного сократить время. В пределах минуты будет нормально.
 
Цитата
Шерзод Маткаримов написал:
Может сможете еще немного сократить время. В пределах минуты будет нормально.
Хорошо, давайте попробуем продолжить.
Дальнейшее обсуждение в почте.
 
Цитата
Михаил Витальевич С. написал:
Хорошо, давайте попробуем продолжить.
Давайте. Буду рад если сами выполните работу.
 
Шерзод Маткаримов, нашел решение самостоятельно, немного лучшее, чем мое.
Страницы: 1
Читают тему (гостей: 1)
Наверх