Страницы: 1 2 След.
RSS
Макрос фильтрации очень медленно работает
 
Здравствуйте, форумчане!

Помогите, пожалуйста, в очередной раз с Excel.
Я (не без вашей помощи  :) ) написала макрос, который работает на моих примерах в 10-20 строк.
Но когда я перенесла только первую команду в рабочую таблицу в 100 000 строк и решила проверить, как он работает, оказалось, что он не работает вообще.
Крутится "колёсико", макрос выполняет задание бесконечно долго, в течение минут 40 крутился, так и не выполнил, я прервала его Esc.

Код
Option Explicit

Sub perenos1()

Dim i As Long
Dim last As Long
Dim last1 As Long
Dim found As Range
Dim word1 As String

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
If Workbooks.Count Then
ActiveWorkbook.ActiveSheet.DisplayPageBreaks = False
End If
Application.DisplayStatusBar = False
Application.DisplayAlerts = False

last = Worksheets("Выгрузка").Cells(Rows.Count, 70).End(xlUp).Row
last1 = Worksheets("Лист").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To last

word1 = "*Ошибка*"

Set found = Worksheets("Выгрузка").Cells(i, 70).Find(word1)

If Not found Is Nothing Then

Worksheets("Лист").Cells(last1 + 1, 1).Resize(, 30).Value = Worksheets("Выгрузка").Cells(i, 70).Resize(, 30).Value
last1 = last1 + 1

End If
Next

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
If Workbooks.Count Then
ActiveWorkbook.ActiveSheet.DisplayPageBreaks = True
End If
Application.DisplayStatusBar = True
Application.DisplayAlerts = True 
End Sub

Это только первая операция по переносу на другой лист. У меня таких же действий планируется 5, каждый раз надо будет переносить по определенному критерию.

Я нашла информацию, как ускорить код, вставила в свой макрос все команды, которые отключают автоматический пересчет, отключение обновления экрана и всё-всё, что нашла, но результата я так и не увидела...
 
Быстрее будет отфильтровать и сразу всё скопировать, если я правильно понял.
Ну а так - строку 27 вынести из цикла, поиск заменить на like, работу с ячейками заменить на работу с массивом данных...
 
ну и можно искать в столбце нужное и работать с найденной строкой, после искать следующую строку.
По вопросам из тем форума, личку не читаю.
 
Ну и ещё вопрос сколько этих "*Ошибка*" там вообще предвидится. Если мало - искать в столбце, если много - цикл по массиву данных думаю будет быстрее.
Но самое быстрое и универсальное думаю будет фильтр.
Изменено: Hugo - 22.04.2020 23:36:18
 
Я делала свой тестовый пример с фильтром, выделением только видимых ячеек и копированием-вставкой, но на даже на 20 строках это работало совсем не мгновенно... Видимо я некорректно написала код, поэтому и медленно было.
Вообще планируется всю таблицу из 100 000 строк распределить по листам.
Спасибо вам всем за советы, я попробую всё это сделать!
 
Может это поможет

Код
Sub perenos1()
    Dim i&, last&, sht As Worksheet, sh As Worksheet
    Dim last1&, arr(), j&, k&
    Const word1$ = "*Ошибка*"
    
    Set sht = Worksheets("Выгрузка")
    Set sh = Worksheets("Лист")
    last = sht.Cells(sht.Rows.Count, 70).End(xlUp).Row
    last1 = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row
    arr = sht.Range("a2", sht.Cells(last, 70)).Value
    For i = 1 To UBound(arr)
        If arr(i, 70) Like word1 Then
            k = k + 1
            For j = 1 To UBound(arr, 2)
                arr(i, j) = arr(k, j)
            Next j
        End If
    Next
    If k > 0 Then sh.Range("a" & last1).Resize(k, 30).Value = arr
End Sub
"Все гениальное просто, а все простое гениально!!!"
 
suricat555, здравствуйте
Цитата
suricat555: Макрос фильтрации
а вам не кажется странным, что в теме по "фильтру" фильтра-то нет…?  :D
В вашем случае, правильнее сказать "отбор по критерию"
Изменено: Jack Famous - 23.04.2020 09:50:56
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous,  Лингвист Вы наш  :D . А что делает Фильтр - как не отбирает по критерию? Другое дело что это совпадает с названием инструмента....
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ: это совпадает с названием инструмента
вот именно
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Я опробовала макрос от Nordheim (сообщение 6), он работает быстро! Спасибо! ;) Начала его разбирать, и обнаружила команду по определению последней заполненной ячейки, она отличается от моей подобной команды: у Александра в скобках указан лист перед Rows, а у меня нет:  

Код
last = sht.Cells(sht.Rows.Count, 70).End(xlUp).Row 


мой:

Код
last = Worksheets("Выгрузка").Cells(Rows.Count, 70).End(xlUp).Row


Обе команды определили ячейку. Подскажите, пожалуйста, если обе команды выполнили задачу верно, то можно использовать любую из них, или всё же правильнее указывать лист перед Rows в скобках, как это сделал Александр?
 
Rows.Count -число строк на активном листе. Если вдруг будет открыт файл xls, то это 65536  и если лист Worksheets("Выгрузка") в другой книге и данных там больше, то  будет проблема.
По вопросам из тем форума, личку не читаю.
 
БМВ, спасибо!  :)
 
Можно еще немного ускорить указав в цикле          
Код
For j = 1 To UBound(arr, 2)
     arr(i, j) = arr(k, j)
Next j

вместо UBound(arr, 2) число 30, т.к. на лист выгружаются всего 30 столбцов.
Изменено: Nordheim - 25.04.2020 19:27:43
"Все гениальное просто, а все простое гениально!!!"
 
Александр, спасибо Вам, я попробую!
 
Цитата
Nordheim написал:
Можно еще немного ускорить указав в цикле вместо UBound(arr, 2) число 30
На сколько миллипусиков?
 
Цитата
RAN написал:
На сколько миллипусиков?
Все зависит от размера массива  :D
"Все гениальное просто, а все простое гениально!!!"
 
Цитата
Nordheim: Все зависит от размера массива
вангую, что даже на миллионах прирост не будет заметен  :D

как-то тестилось тут на форуме. Обращение к границам массива не занимает сколь заметно больше времени, чем статичное число, т.к. эти границы не вычисляются каждый раз, а хранятся в памяти
Изменено: Jack Famous - 26.04.2020 10:16:01
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Доброе время суток
Цитата
Jack Famous написал:
вангую, что даже на миллионах прирост не будет заметен
Соглашусь.
Код
Public Sub UboundAccessTest()
    Dim arr(1 To 100, 1 To 1000000) As Double
    Dim t1 As Single, t2 As Single, i As Long
    Dim tmp As Long
    t1 = Timer
    For i = 1 To 1000000000
        tmp = UBound(arr, 2)
    Next
    t1 = Timer - t1
    t2 = Timer
    For i = 1 To 1000000000
        tmp = 1
    Next
    t2 = Timer - t2
    Debug.Print "t2 = " & CStr(t2) & " and t1 = " & CStr(t1)
End Sub

Скорость выполнения Ubound от размерности не зависит. Для верней границы 1000000 по второму индексу
Цитата
t2 = 5,257813 and t1 = 7,28125
t2 = 5,265625 and t1 = 7,820313
Для верней границы 100
Цитата
t2 = 5,0625 and t1 = 7,535156
t2 = 5,078125 and t1 = 7,910156
Использование Ubound постоянно в среднем в 1,46 дольше по времени, чем константы. Но, опять же, не зависит от величины верней границы.
 
Андрей VG,  У вас немного не корректный пример, я не переименовал UBound(arr,2) в 30, а сократил, т.к. массив имеет вторую размерность 70 а не 30
поэтому корректней будет сравнивать так

Код
Sub main()
    Dim arr(1 To 100, 1 To 1000000) As Double
    Dim t1 As Single, t2 As Single, i As Long
    Dim tmp As Long, j&
    t1 = Timer
    For i = 1 To 1000000000
        tmp = UBound(arr, 2)
    Next
    t1 = Timer - t1
    t2 = Timer
    For i = 1 To 1000000000
        For j = 1 To 40
            tmp = 1
        Next j
    Next
    t2 = Timer - t2
    Debug.Print "t2 = " & CStr(t2) & " and t1 = " & CStr(t1)
End Sub

А это уже совсем другая история.
Попробуйте запустить, что получится в приросте скорости

у меня так
Цитата
t2 = 218,7344 and t1 = 6,964844

На 1 100000 строк разница почти не заметна

Цитата
t2 = 1,953125E-02 and t1 = 0
но если запустить миллион или цикл по листам все равно прирост будет, может небольшой но будет,
для глаза не заметно, но это оптимизация  :D
Тут суть в том что бы не бегать по лишним столбцам массива, все равно на лист переносится конкретное число столбцов, поэтому и написал сообщение №13, может
кому на будущее пригодится, а по сути думаю, что даже процедура из сообщения №6  отрабатывает в разы быстрее чем тот макрос, с которого тема начиналась.
Но на этот вопрос может ответить только ТС, т.к. файла примера не было, а создавать самому лень.
Изменено: Nordheim - 26.04.2020 11:18:43
"Все гениальное просто, а все простое гениально!!!"
 
Цитата
Nordheim написал:
А это уже совсем другая история.
Естественно, с чего бы цикл в цикле был быстрее?
 
Цитата
Андрей VG написал:
Естественно, с чего бы цикл в цикле был быстрее?
Так о том и речь, что я написал сокращение столбцов цикла, который уже в цикле, поэтому мне и непонятен Ваш пример
Изменено: Nordheim - 26.04.2020 11:21:03
"Все гениальное просто, а все простое гениально!!!"
 
Андрей VG, Тут походу вас ввел в заблуждение Jack Famous,  ;)
Я не утверждал, что указание цифры вместо UBound() , будет отрабатывать быстрее при равном их значении. Я писал про конкретный случай, а не в общем
Изменено: Nordheim - 26.04.2020 11:25:18
"Все гениальное просто, а все простое гениально!!!"
 
Цитата
Nordheim: походу вас ввел в заблуждение  Jack Famous ,  Я не утверждал, что указание цифры вместо UBound() , будет отрабатывать быстрее при равном их значении
ваше сообщение было довольно двусмысленным, так что неудивительно))
Судя по всему (надо было предыстроию посмотреть), вы имели ввиду, что нет смысла выгружать весь массив (более 30 столбцов), если нужно/заполнено всего 30 — верно?
В таком случае, это, разумеется, логично (время выгрузки сильно меняется от размера массива), но и поднятие вопроса о скорости обращения к данным различного типа будет нелишним  ;)
Изменено: Jack Famous - 26.04.2020 15:01:26
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Nordheim написал:
Андрей VG , Тут походу вас ввел в заблуждение  Jack Famous ,
Неча на зеркало пенять.  :D
То, что сейчас в #13, и то, что я процитировал в #15, вещи совершенно различные.
 
Цитата
RAN написал:
Неча на зеркало пенять.   То, что сейчас в #13, и то, что я процитировал в #15, вещи совершенно различные.
Не совсем понял к чему это?
"Все гениальное просто, а все простое гениально!!!"
 
Для вас способ определения конца цикла, и принудительное изменение размера цикла, это однородно?
 
Цитата
Jack Famous написал:
нет смысла выгружать весь массив (более 30 столбцов), если нужно/заполнено всего 30 — верно?
да
Цитата
Jack Famous написал:
но и поднятие вопроса о скорости обращения к данным различного типа будет нелишним
я не обучаю в темах, а оптимизирую конкретный процесс, если вдаваться в подробности , то тут можно целую книгу написать.
Думаю, что ТС результат устроил, и не вижу смысла дальнейшего флуда не по теме.
Всем Спасибо!
Изменено: Nordheim - 26.04.2020 16:22:21
"Все гениальное просто, а все простое гениально!!!"
 
Я невнимательно посмотрела, когда пробовала макрос Александра - к сожалению, переносятся не те строки... Я сравнила по количеству - совпало, а на переносимый текст внимания не обратила.  
Я пыталась понять, в чём причина, билась несколько дней, но я боюсь, что без вашей помощи я не справлюсь. Помогите мне, пожалуйста!
Я сделала файл с примером на 50 строк (пример на 100 000 не загрузился). Там вставлен макрос, который писал Александр, я написала комментарии к каждому действию, но я не поняла, что за переменная j. Объясните, пожалуйста, что это за операции с j? Как правильно можно написать комментарий?
В примере есть 2 листа: "Данные" и "Перенос". На листе "Данные" заполнено 5 столбцов, 50 строк, столбец C содержит три разных комментария. Комментарий со словом Перенос нужно перенести в лист "Перенос". Всего должно перенестись 23 строки. При запуске макроса perenos данные переносятся почти в нужном количестве (23 строки включая шапку, но если с шапкой - то должно быть 24 строки: шапка + 23 строки с ключевым словом). Я думала что на лист Перенос попадают первые строки массива, но они переносятся как-то странно - сначала копируется шапка 4 раза, затем строки идут по порядку, а потом нумерация путается (можно по фильтру посмотреть - на листе "Перенос" есть проверка - если 1, значит строки переносятся друг за другом. Но там я не поняла логики. В любом случае перенеслось не по нужному комментарию - попали все комментарии кроме нужного)))). Почему-то на примере в 50 строк путаницы в нумерации особо не видно, но когда я пробовала на 100 000 строк - это заметно.
Помогите, пожалуйста, разобраться.
 
Как-то так, примерно...
 
Конкретно под ваш файл пример.

Код
Sub perenos1()
    Dim i&, last&, sht As Worksheet, sh As Worksheet
    Dim last1&, arr(), j&, k&
    Const word1$ = "*Перенос*"
     
    Set sht = Worksheets("Данные")
    Set sh = Worksheets("Перенос")
    last = sht.Cells(sht.Rows.Count, 3).End(xlUp).Row
    sht.[c1].Resize(, 6).Copy sh.[a1]
    last1 = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row + 1
    arr = sht.Range("c2", sht.Cells(last, "h")).Value
    For i = 1 To UBound(arr)
        If arr(i, 1) Like word1 Then
            k = k + 1
            For j = 1 To UBound(arr, 2)
                arr(i, j) = arr(k, j)
            Next j
        End If
    Next
    If k > 0 Then sh.Range("a" & last1).Resize(k, UBound(arr, 2)).Value = arr
End Sub
"Все гениальное просто, а все простое гениально!!!"
Страницы: 1 2 След.
Наверх