Страницы: 1
RSS
Медленная работа макроса, удаляющего пустые строки.
 
Добрый вечер всем! Возникла непонятная ситуация-для переноса из рабочей книги в отдельную книгу готового результата
используются три макроса-первый создает новую книгу и переносит туда лист, второй заменяет формулы на значения
а третий удаляет пустые строки. по отдельности первый и второй отрабатывают за несколько секунд.третий крутит 10 минут.
Отключаю автоматический пересчет формул и он тоже отрабатывает за пять секунд.Похоже, его тормозит пересчет формул.
Но первые два и без отключения автоматического пересчета работают быстро.
При переносе вручную в новую книгу и запуске этого макроса удаления строк-он работает быстро.  
Подозреваю что это макрос не очень удачно написан.Возможно его как-то изменить,
чтобы его работа не замедлялась формулами? или нужно добавить оперативки-у меня четыре гига оперативной памяти а рабочая книга-5 мегабайт.
Как он должен работать-пропускать верхние несколько строк-сейчас там стоит 7 строк, затем если ячейка в столбце А пустая-удалять всю строку и так до последней заполненной ячейки столбца А.  Представленный работает именно так, но мееедленоооо. Спасибо!  
 
загрузи данные из рабочей книги в массив
Обработай массив (отсортируй) и вывали в новую книгу
 
Странно получается- было 600+- строк- макрос работал секунд двадцать, стало 1200 строк-продолжительность его работы увеличилась более чем в двадцать раз!
подумалось- может он удаляет по одной строке, а у меня массивы пустых строк по 5-20 подряд, и если макрос сначала обнаружит такой массив, а затем удалит его сразу целиком- то его скорость вырастет?
 
Добавил оперативки 4 гига-не помогло ни капли, потом здесь на сайте в комментах к статье про удаление пустых строк увидел макрос- и он отработал за пару сек!, действительно дело было в макросе- старый жевал десять минут, этому хватает полторы-две секунды.!
Изменено: ПРОИЗВЕД - 11.04.2021 18:29:16
 
ПРОИЗВЕД   Вы свой макрос для удаления строк у диверсантов наверно раздобыли? К чему там функция Len        
 
Цитата
ПРОИЗВЕД написал:
Добавил оперативки 4 гига-не помогло
ПРОИЗВЕД, Вы #2 читали?
Цитата
Александр Моторин написал:
загрузи данные из рабочей книги в массив
А Вы все равно строки на листе продолжаете удалять. Попробуйте 40 гигов оперативки, возможно поможет :)
Код
Sub удаление_строк_1()
    Dim ar, r, nr
ar = Range("A7:A" & Cells(Rows.Count, 1).End(xlUp).Row)
For r = 1 To UBound(ar)
 If ar(r, 1) <> "" Then
    nr = nr + 1
    ar(nr, 1) = ar(r, 1)
 End If
Next r
    Range("A:A").ClearContents     'очищаем старые данные
    Range("A1").Resize(nr) = ar    'сюда выгружаем. Если нужно не сюда поставьте куда нужно.
End Sub
 
Цитата
_Igor_61 написал: Вы #2 читали
читал, сначала слева направо, потом справа налево-знакомые слова увидел,-ничего не понял. Ваш макрос не удаляет строки-он данные смещает вверх, а форматирование остается. Удаление строки-с заливкой,со всеми прочими. Но на самом деле-проблема решена, выше уже выложил то что мне оказалось в тему. Итс ворк.

Цитата
Евгений Смирнов написал: Вы свой макрос для удаления строк у диверсантов наверно раздобыли? К чему там функция Len        
Наверное хорошая шутка, жаль не могу оценить-посмотрел len, считает количество символов-в самом деле не знаю зачем, вы хотите сказать что из-за этого тормоза? В любом случае этот макрос ушел на пенсию.

Отписался-потому что проблему решил, может кому пригодится, а то сын жалуется на русскоязычные сайты-половина тем-издрасти, как сделать тото-и-тото..спасибо проблему решил тема закрыта.-епрст-как решил-почему не выложил решение?Жадность? Глупость? Гугл, топаем дальше...
 
Цитата
ПРОИЗВЕД написал: Добавил оперативки 4 гига-не помогло ни капли
Если комп слабый и строк для проверки много этот макрос можно еще оптимизировать, убрав на каждом шаге цикла проверку не является область rng пустой, задав первоначальное значение этой области как первая строка после всех используемых на странице. Конечно же страница, в этом случае, заведомо не должна использовать всю возможную область.
Код
Sub rows_del()
Dim r As Long, rng As Range
Set rng = Rows(ActiveSheet.UsedRange.Rows.Count + 1)
    For r = 1 To ActiveSheet.UsedRange.Rows.Count
        If Application.CountA(Rows(r)) = 0 Then Set rng = Union(rng, Rows(r))
    Next r
rng.Delete
End Sub
 
ino, не заметил разницы с вашего макроса и с 4 сообщения.
 
Цитата
ino написал:
Если комп слабый и строк для проверки много
и мног строк для удаления,  то юнион будет тормозить и оптимизировать гужно совсем иначе.
По вопросам из тем форума, личку не читаю.
 
Цитата
ПРОИЗВЕД: Медленная работа макроса, удаляющего пустые строки
Цитата
БМВ: оптимизировать нужно совсем иначе
решено давным давно (ZVI исследовал данный вопрос): строки для удаления должны идти подряд, то есть перед удалением строк их нужно отсортировать по критерию удаления
Причина: Excel очень тупит при удалении строк отдельными "кусками", а Union (помимо того, что это сама по себе очень тормозная функция) может помочь лишь на небольших объёмах
Изменено: Jack Famous - 20.04.2021 08:58:23
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
: строки для удаления должны идти подряд,
в моем случае невыполнимое условие, у меня не просто строки а документ, объединенные ячейки, заливка, рамки и пр. Найденный макрос из п 4 грызет 1300 строк за 2 сек. Большего не требуется.
 
Цитата
ПРОИЗВЕД: Найденный макрос из п 4
хоть бы нормально коды показали - зачем в файлы прятать?
С другой стороны, тут ничего интересного
Если нужно будет ускорить ещё в несколько раз (может, в десятки) и  БЕЗ сортировки - обращайтесь
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Если нужно будет ускорить ещё в несколько раз (может, в десятки) и БЕЗ сортировки
Jack Famous
, не заводись...)
Изменено: Marat Ta - 20.04.2021 17:29:49
 
Цитата
Marat Ta: не заводись...)
мы с вами на "ты" не переходили
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
зачем в файлы прятать?
не знал как это сделать. Теперь кажется знаю...
Код
Dim r As Long, rng As Range
    For r = 1 To ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
        If Application.CountA(Rows(r)) = 0 Then
            If rng Is Nothing Then Set rng = Rows(r) Else Set rng = Union(rng, Rows(r))
        End If
    Next r
    If Not rng Is Nothing Then rng.Delete 


Изменено: ПРОИЗВЕД - 20.04.2021 16:55:37
 
Цитата
ПРОИЗВЕД: не знал как это сделать. Теперь кажется знаю
откройте мир спойлеров и увидите, что коды я уже показал, зато можно и самому научиться на голову выше оформлять свои посты  ;)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Спасибо
Изменено: ПРОИЗВЕД - 20.04.2021 18:22:26
Страницы: 1
Наверх