Всем привет! Нужна Ваша помощь или совет. В работе использую макрос, который по условию определенного столбца вырезает строки с одного листа и вставляет их на другой. Понятно, что макрос далеко не идеальный, но вопрос заключается в том, что если выбрать одну-две, ну или 3 строки, то макрос работает относительно быстро, но если же взять большее количество строк, то макрос работает уж очень долго.. эксель даже подвисает... и выполнение макроса может занимать до 20-30 сек, а то и более. Можно ли как-нибудь ускорить работу? ps лист, с которого вырезаю строки имеет большое кол-во формул и условного форматирования.. может быть с этим связана долгая работа?
Заранее спасибо.
[vba]
Код
Dim i As Integer Dim sch As Integer Dim zn As String Dim sht As Long Sub Вырезать()
sch = 0 zn = "*Не действует*" sht = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row + 1 For i = 5000 To 3 Step -1 If LCase(Cells(i, 31)) Like LCase(zn) Then sch = sch + 1 Sheets(1).Range(Cells(i, 1), Cells(i, 31)).Copy Sheets(2).Range("A" & sht).PasteSpecial (xlPasteValues) Rows(i).Delete sht = sht + 1 End If Next i
Всем привет! Нужна Ваша помощь или совет. В работе использую макрос, который по условию определенного столбца вырезает строки с одного листа и вставляет их на другой. Понятно, что макрос далеко не идеальный, но вопрос заключается в том, что если выбрать одну-две, ну или 3 строки, то макрос работает относительно быстро, но если же взять большее количество строк, то макрос работает уж очень долго.. эксель даже подвисает... и выполнение макроса может занимать до 20-30 сек, а то и более. Можно ли как-нибудь ускорить работу? ps лист, с которого вырезаю строки имеет большое кол-во формул и условного форматирования.. может быть с этим связана долгая работа?
Заранее спасибо.
[vba]
Код
Dim i As Integer Dim sch As Integer Dim zn As String Dim sht As Long Sub Вырезать()
sch = 0 zn = "*Не действует*" sht = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row + 1 For i = 5000 To 3 Step -1 If LCase(Cells(i, 31)) Like LCase(zn) Then sch = sch + 1 Sheets(1).Range(Cells(i, 1), Cells(i, 31)).Copy Sheets(2).Range("A" & sht).PasteSpecial (xlPasteValues) Rows(i).Delete sht = sht + 1 End If Next i
1. Нужно бы видеть пример кода в файле. Потому что сейчас я вижу потенциальную ошибку, вернее вот тут ошибка: [vba]
Код
Sheets(1).Range(Cells(i, 1), Cells(i, 31)).Copy
[/vba] Или лишнее, судя по остальным строкам кода. 2. Если нужны только значения, то быстрее это делать через массив, не копируя сами строки. 3. Ну а удаление строк можно сделать позже, сразу всех одним действием. Думаю основные тормоза на этом.
1. Нужно бы видеть пример кода в файле. Потому что сейчас я вижу потенциальную ошибку, вернее вот тут ошибка: [vba]
Код
Sheets(1).Range(Cells(i, 1), Cells(i, 31)).Copy
[/vba] Или лишнее, судя по остальным строкам кода. 2. Если нужны только значения, то быстрее это делать через массив, не копируя сами строки. 3. Ну а удаление строк можно сделать позже, сразу всех одним действием. Думаю основные тормоза на этом.Hugo
1. Нужно бы видеть пример кода в файле. Потому что сейчас я вижу потенциальную ошибку, вернее вот тут ошибка:
сделал максимально приближенный к рабочему файлу кусок.
Суть в том, что в рабочей таблице более 800 заполненных строк и ежедневно в столбце АЕ руками (из предложенного списка) проставляем статус "Не действует". Таких статусов может быть как 1, так и 20, 30, 100 и все они в разных местах таблицы, т.е. в середине, снизу и вверху, что в принципе логично Далее по кнопке выполняем макрос и тут начинаются проблемы.. чем больше строк со статусом "не действует", тем дольше отрабатывает макрос
Как и говорил, в основной таблице полно формул, условного форматирования и тд, но при вырезании оно не нужно, нужны только значения. Все ломаю голову и не понимаю, как ускорить процесс выполнения макроса..
1. Нужно бы видеть пример кода в файле. Потому что сейчас я вижу потенциальную ошибку, вернее вот тут ошибка:
сделал максимально приближенный к рабочему файлу кусок.
Суть в том, что в рабочей таблице более 800 заполненных строк и ежедневно в столбце АЕ руками (из предложенного списка) проставляем статус "Не действует". Таких статусов может быть как 1, так и 20, 30, 100 и все они в разных местах таблицы, т.е. в середине, снизу и вверху, что в принципе логично Далее по кнопке выполняем макрос и тут начинаются проблемы.. чем больше строк со статусом "не действует", тем дольше отрабатывает макрос
Как и говорил, в основной таблице полно формул, условного форматирования и тд, но при вырезании оно не нужно, нужны только значения. Все ломаю голову и не понимаю, как ускорить процесс выполнения макроса.. Artem2292
Сообщение отредактировал Artem2292 - Воскресенье, 01.11.2020, 23:01
Доброе время суток. Сделайте сортировку по столбцу "Статус". Тогда "не действует" будет последовательной группой строк. Общим блоком копируете на нужный лист, а затем удаляете. Восстанавливаете исходное состояние по столбцу "№". Будет быстро.
Доброе время суток. Сделайте сортировку по столбцу "Статус". Тогда "не действует" будет последовательной группой строк. Общим блоком копируете на нужный лист, а затем удаляете. Восстанавливаете исходное состояние по столбцу "№". Будет быстро.anvg
100 строк можно и в union собрать. чтоб не усложнять код. Просматривать 5000 стро тоже лишнее, если их реально другое количество. Сравнивать LCase(Cells(i, 31)) Like LCase(zn) тоже лишнее, ведь там только равно или нет может быть. Да и LCase можно исключить хотя бы на одной половине, да и вообще т.к. вариаций быть не может. А если бы даже и были - Option Compare Text решает проблемы регистра. И звёздочки зачем? Убираем звёздочки, Like и LCase - уже экономия P.S. Вот изменил по минимуму что было, проверьте.
100 строк можно и в union собрать. чтоб не усложнять код. Просматривать 5000 стро тоже лишнее, если их реально другое количество. Сравнивать LCase(Cells(i, 31)) Like LCase(zn) тоже лишнее, ведь там только равно или нет может быть. Да и LCase можно исключить хотя бы на одной половине, да и вообще т.к. вариаций быть не может. А если бы даже и были - Option Compare Text решает проблемы регистра. И звёздочки зачем? Убираем звёздочки, Like и LCase - уже экономия P.S. Вот изменил по минимуму что было, проверьте.Hugo
Приветствую В файлике-примере и в рабочем файле все работает замечательно до момента, если строк со статусом "не действует" всего 3. Если строк уже больше, сразу выходит ошибка сразу ошибка runtime error 9 subscript out of range Покопался в макросе, понял, что проблема выходит на строке [vba]
Код
ReDim out(1 To 3, 1 To 31)
[/vba] поменял 3 на большую цифру и все заработало. Спасибо за помощь . Буду дальше разбирать и изучать этот макрос
Приветствую В файлике-примере и в рабочем файле все работает замечательно до момента, если строк со статусом "не действует" всего 3. Если строк уже больше, сразу выходит ошибка сразу ошибка runtime error 9 subscript out of range Покопался в макросе, понял, что проблема выходит на строке [vba]
Код
ReDim out(1 To 3, 1 To 31)
[/vba] поменял 3 на большую цифру и все заработало. Спасибо за помощь . Буду дальше разбирать и изучать этот макросArtem2292
Глупая моя ошибка, специально ведь чуть выше высчитывал Поменяйте не на цифру, а на переменную: [vba]
Код
ReDim out(1 To x, 1 To 31)
[/vba] Т.е. логика такая - определили какой массив будет нужен (хотя можно конечно делать как Вы - на всю область с запасом), в цикле переложили в него данные, и сразу собрали объект для удаления. Затем выгрузили массив, удалили объект.
Глупая моя ошибка, специально ведь чуть выше высчитывал Поменяйте не на цифру, а на переменную: [vba]
Код
ReDim out(1 To x, 1 To 31)
[/vba] Т.е. логика такая - определили какой массив будет нужен (хотя можно конечно делать как Вы - на всю область с запасом), в цикле переложили в него данные, и сразу собрали объект для удаления. Затем выгрузили массив, удалили объект.Hugo
[/vba] иначе, если в таблице не было статуса "Не действует" и случайно нажать кнопку "убрать в архив", вылезала ошибка runtime error 9 subscript out of range в общем спасибо! Буду дальше изучать для себя мир VBA
[/vba] иначе, если в таблице не было статуса "Не действует" и случайно нажать кнопку "убрать в архив", вылезала ошибка runtime error 9 subscript out of range в общем спасибо! Буду дальше изучать для себя мир VBA Artem2292
Сообщение отредактировал Artem2292 - Понедельник, 02.11.2020, 13:47