Приветствую знатоков макросов. Нужна помощь по оптимизации макроса. Нижеследующий макрос выполняет задачу за 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 минуты, но форматирование обязательно нужно.
Мне сказали, что не все специалисты охотно берутся за оптимизацию макросов, но я надеюсь кого-нибудь эта работа заинтересует. Если кто-нибудь сможет выполнить этот заказ, могу отправить сам файл с макросом на почту.
Апострофф, доброго здоровья; и всем тоже - доброго здоровья! Я нашел, как мне кажется, несколько мест, где явно можно ускорить. Но такую прибавку не даст. Да, и, на моем компе макрос отрабатывает примерно за минуту-полторы (таймером не проверял), так что....
ну, если на макрос в первом сообщении посмотреть, то строки с 8 по 35 - форматирование диапазонов; но здесь я и не вижу, как можно ускорить; и строки 39-52; здесь в цикле форматируются 20 000 ячеек, по одной - вот здесь можно ускорить, собрав в диапазоны. Макрос в файле немного отличается от показанного и там есть еще пара узких мест подобного типа.
sherzodom написал: Формулы на листе очень простые и они не замедляют макрос.
Вставлю свои пять копеек. Возможно не прав. Недавно свой код оптимизировал. Дело не в сложности формул, а в том, что Excel после каждой вставки/изменении формулы производит проверку всей таблицы на предмет зависимостей и пересчитывает зависимые ячеки, вот на этом моменте и тормозит. Если отключить авто пересчет, то Excel будет в памяти составлять дерево зависимостей без пересчета и процесс пойдет несколько быстрее. Потом надо включить автопересчет и все изменения будут пересчитаны скопом.
Joiner, Еще раз, это не основная ветка и решения тут не публикуются. Не знаю как остальные, но я считаю что тут можно дать комментарии, которые позволяют лучше понять или пояснить задачу, что позволяет быстрее, точнее найти исполнителя, даже если это сам ТС, но не обсуждать решение. Да и общий смыcл посыла "макрос + формулы = тормоз" - не верен. Хотите поспорить то в ветке курилка.
из моего опыта: в любой задаче отчеты должны быть отделены от данных любая попытка совмещения - ошибка формулы в данных - недопустимы, только чистые данные, если что-то нужно преобразовывать - макрос: пользователь ввел значение, макрос растолкал по соседним ячейкам результаты вычислений тут 20 тыс.строк, если там одна колонка с формулами их уже 20 тыс. шт., а если несколько? умножаем на 2,3 ... до 1000 формул - вообще не заметно до 5000 - могут появиться подозрения, что что-то тут вычисляется 20тыс. и более - будьте готовы подождать пару секунд, пару десятков секунд, пока Excel пересчитает их все, потому что пользователь что-то изменил в какой-то одной ячейке не принимайте все сказанное за абсолютные истины, формулы формулам рознь, у компьютеров разная производительность (вычислительная мощь), но приблизительно это работает так, и если вы пошли по пути наращивания количества формул в документе, то будьте готовы к тому, что на каком-то этапе реальность заставит вас задуматься как свернуть с этой дорожки, чтобы не палить нервы каждый раз ,когда из ячейки вы вышли не ESCом, а ENTERом
Спасибо за проявленный интерес к этой задаче. Написали несколько специалистов, кто-то отказал, кто-то не отвечает и кто-то предложил написать новый макрос, и вопрос всё еще актуален.
Протестировал файл внося некоторые изменения. Убрал все листы из файла кроме текущей, где работает макрос, время работы макроса сократилось на 1 мин., хотя связи с другим листами в этом макросе нет, разве только 3 скрытых листа показывает (.Visible = True). Получается в уменьшенном файле макрос работает быстрее? Не понятно.
Также, цикл For i = 14 To 20000 замедляет на 1 минуту, но заменить его не получается. Хотел в макросе убрать этот цикл и применить Условное форматирование, но перед запуском этого макроса, предварительно очищается рабочая область, и тогда УФ исчезает.
Наверное, лучше будет написать новый макрос, который будет выполнять задачу в памяти и реально быстрее работать. Я попробую написать ТЗ, и файл который уже есть показывает какой результат нужен.
Если этот макрос(он самый медленный) получится создать как хотелось бы, на очереди есть еще пару макросов из этого же файла. Опытный пользователь используя шаблон и применяя несколько формул может выполнять этот же отчёт значительно быстрее чем этот файл, поэтому без быстрых макросов файл не так полезен.