| Цитата |
|---|
| ole-van-de: родной ручной фильтр Excel на 50 тыс строк работает быстро, секунда-две, но он ограничен двумя условиями ИЛИ (содержит слово..). А мне надо было до 6 условий. Неужели vba тугодумный... |
обычно дело в прокладке…между рулём и сиденьем, как говорят механики
Действительно, откуда разница, если я сравниваю 2 критерия с 6ю, притом диапазон со словами проверки у меня вообще на 9 ячеек (а значит и условий 9), да ещё я копирую по одной строке, да ещё и целиком, да ещё и обновление экрана не отключаю. Действительно, одно и то же
Погуглите про методы и способы ускорения работы макросов…
Так должно быть пошустрее (проверьте диапазон проверяемых фраз)
| Код |
|---|
Sub Copy()
Dim x, arr, arrList, r&, n&, c As Byte
arrList = ActiveWorkbook.Worksheets("FilterWords").Cells(2, 5).Resize(10, 1).Value2 ' массив слов для поиска: со второй строки 5-го столбца берём 10 строк вниз
If Not IsArray(arrList) Then arrList = Array(arrList)
arr = ActiveWorkbook.Worksheets("Sheet2").UsedRange.Value2 ' берём в массив всю рабочую область листа, откуда копировать
n = 1 ' оставляем первую строку с шапкой
For r = 2 To UBound(arr, 1) ' проходим по всему массиву со 2ой строки
For Each x In arrList ' проходим по всему списку слов
If arr(r, 6) Like "*" & x & "*" Then ' если слово содержится, то наполняем массив
n = n + 1
For c = 1 To UBound(arr, 2)
arr(n, c) = arr(r, c)
Next c
Exit For
End If
Next x
Next r
If n = 1 Then Exit Sub ' если счётчик не изменился, то вставлять нечего
Application.ScreenUpdating = False
Worksheets.Add
ActiveSheet.Cells(1, 1).Resize(n, UBound(arr, 2)).Value2 = arr
Application.ScreenUpdating = True
End Sub |
