Данная функция ищет в массиве все строки, подходящие под заданные критерии, и возвращает результат в виде отфильтрованного массива:
PS: Код обновлён 4 января 2021 года, — теперь он работает в 40 раз быстрее, нежели прежняя версия функции
Function ArrAutofilterNew(ByRef arr, ParamArray args() As Variant) As Variant ' Новая версия функции ArrAutofilter, от января 2021 года. © ExcelVBA.ru ' Получает по ссылке массив ARR для фильтрации ' и список критериев фильтрации в формате "3=маска текста" (номер столбца, "=", искомое значение) ' Возвращает двумерный массив с подходящими строками On Error Resume Next ArrAutofilterNew = False ' возвращаемое значение в случае ошибки If UBound(args) = -1 Then Debug.Print "Array filtering error: filters required": Exit Function ReDim Filters(1 To UBound(args) + 1, 1 To 2) Dim i&, ColumnToCheck&, FiltersCount&, j&, ro&, RowsCount&: Err.Clear: i& = UBound(arr, 2) If Err.Number > 0 Then Debug.Print "Array filtering error: two dimensional array required": Exit Function For i& = LBound(args) To UBound(args) ' перебираем все параметры фильтрации If Not IsMissing(args(i&)) Then If args(i&) Like "#*=*" Then ' распознаем параметры фильтрации FiltersCount& = FiltersCount& + 1 Filters(FiltersCount&, 1) = Val(Split(args(i&), "=")(0)) ' столбец массива Filters(FiltersCount&, 2) = Split(args(i&), "=", 2)(1) ' маска для значения Else ' неверно заданный фильтр Debug.Print "ArrAutofilterNew error: invalid filter «" & args(i&) & "»" End If End If Next i& If FiltersCount& = 0 Then Debug.Print "Array filtering error: all filters are empty": Exit Function ReDim arrCheck(LBound(arr, 1) To UBound(arr, 1)) As Boolean ' для результатов проверки For i = LBound(arr, 1) To UBound(arr, 1) ' перебираем все строки массива, и проверяем их arrCheck(i) = True For j& = 1 To FiltersCount& ' перебираем все параметры фильтрации If Not (arr(i, Filters(j&, 1)) Like Filters(j&, 2)) Then arrCheck(i) = False: Exit For Next j& RowsCount& = RowsCount& - arrCheck(i) ' увеличиваем счётчик подходящих строк на 1 Next i If RowsCount& = 0 Then Exit Function ' выход, если нет ни одной подходящей строки в массиве ReDim newarr(1 To RowsCount&, LBound(arr, 2) To UBound(arr, 2)) ' формируем новый массив For i = LBound(arr, 1) To UBound(arr, 1) ' снова перебираем все строки массива If arrCheck(i) Then ' если строка ранее помечена как подходящая ro& = ro& + 1 ' вычисляем номер строки в новом массиве For j = LBound(arr, 2) To UBound(arr, 2) newarr(ro&, j) = arr(i, j) ' заполняем массив значениями из исходного Next j End If Next i ArrAutofilterNew = newarr ' возвращаем результат Erase arrCheck End Function
Пример использования:
Sub FilterExample() On Error Resume Next Dim arr As Variant ' отбираем только нужные строки из диапазона a2:t200, ' где текст в третьем столбце начинается с "asy" arr = ArrAutofilterNew(Range("a2:t200").Value, "3=asy*") ' создаем лист, вставляем на него результат Worksheets.Add.Range("a1").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr End Sub
Комментарии
UPD. Разогнал поиск и сопоставление с нескольких часов до нескольких минут для 800к+ записей в одном массиве и 365к+ в другом. если кому интересно - могу поделиться наработками.
Игорь, добрый день.
Доработал Ваш код под свои потребности и дополнительно сделал следующее (как говорил ранее, требуется сопоставление довольно больших массивов):
1. перед вызовом функции формирую временный массив, в котором содержится только 2 колонки: колонка со значениями и колонка с номером строки в исходном массиве.
2. при поиске в функции добавляю в отдельную коллекцию найденные значения (номера строк).
3. если количество найденных элементов более 250 - применяю Ваш способ формирования итогового массива на выходе из функции (т.е. перебором по временному массиву), иначе перебор идет по коллекции. При сотнях тысяц записей прирост по скорости ощутимый. В исходном (из п.1) массиве найденные строки очищаю от значений.
4. после обработки заданного количества строк (например, 5000-10000) удаляю из массива (п.1) пустые строки. Удаление производится перебором (через промежуточный массив), но это позволяет сократить время обработки. Если при первом запуске на 50000 сопоставленных строк тратится 4584 секунды, то после 250 000 - 365 секунд (365 000 записей сопоставлял с 596 000, на все про все ушло порядка 3 часов, при том что если делать сопоставление "в лоб" - потребуется более 7 часов).
Код обработки получился объемный, но попробую как пример сделать лайтовую версию (безусловно, если интересует).
Но без Вас вряд ли смог сделать нормальное решение. Спасибо.
Игорь, доброго времени суток.
Вариант фильтрации массива реализован достойно, но не проще ли сразу номера нужных строк загонять, например, в коллекцию либо словарь и потом на основании сформированного перечня выдавать результирующий массив с нужными строками (чтобы не бегать по исходному массиву несколько раз)? единственное НО - в случае с коллекцией есть ограничение порядка 250 записей (получено опытным путем, в документации не нашел такого).
Так же есть проблема с выводом значений, если найдена всего одна строка - итоговый массив не совсем некорректно формируется (не исключаю, что мои кривые ручки/параметры Excel виноваты, но факт остается фактом и для обхода данного "ограничения") немного поправил строчку: ReDim newarr(RowsCount&, UBound(arr, 2)) (безусловно, в таком случае образуется пустая нулевая строчка, но её можно легко пропустить при дальнейшей обработке результатов (для перфекционистов Redim Preserve в помощь, но оно того не стоит)).
P.S. для моей задачи требуется сравнение двух массивов, в одном порядка 365 000 записей, в другом примерно 800 000 записей (причем сверка производится трижды и тупой перебор через For...Next в лоб слишком медленно отрабатывает, соотношение записей один ко многим). Вариант с формированием поисковой текстовой строки не рассматриваю ибо её размер будет похож на мемуары (сравнение производится по текстовым значениям, индексов нет, при этом в "малом" массиве размер каждого значения около 65 знаков, в "большом" - порядка 130-180 символов)... Собственно по этой причине и подыскиваю оптимальное решение (Ваше в ТОПе).
Иван, попробуйте заменить строку
на что-то типа такого
Отличная функция. Есть вопрос. У меня в двухмерном массиве есть элементы равные Null (получаю массив из рекордсета). И эта функция отбирает строки с этими элементами в новый массив.
Т.е. например две строки массива
15 Труба 89
18 Задвижка Null
условие "2=89". Ожидаю отфильтрует и выведет только первую строку, а получаю и первую, и вторую.
я так понимаю, что получается "Null Like 89" и это обрабатывается как True? Как изменить код?
В итоге поиск "?" по столбцу в массиве так и не заработал, как я ни бился.
"~" не помогает как и писал ранее.
Решил вопрос путем создания следующего алгоритма:
1. Поиск "?" в массиве и замена на "\".
2. Фильтрация массива по "\".
3. Замена "\" обратно на "?".
4. Вывод результатов.
В ячейке указан ? + или -.
Если в качестве критерия поиска по столбцу указываешь 1=~? функция не работает
Чтобы найти текст 123*456?789
ищите такое значение: 123~*456~?789
(добавляем тильду ~ перед спецсимволами типа * и ?)
Добрый день!
Прошу прощения за сумбурные сообщения. Осваиваю VBA..
Все же не подскажете, как с помощью функции либо другого метода можно найти ? или * в значениях массива?
Разобрался. В качестве параметров сьедает массив.
А как быть с поисков вопросительного знака в массиве?
~ не работает..
Добрый день!
Пользователь вводит критерии поиска в форму.
Номер выбранного столбца и критерий поиска сохраняются в два массива.
Просматривая оба массива формирую строку поиска. Пробовал формировать ее по разному и с кавычками и без.
Так и не могу понять как нужно. Подскажите, как корректно сформировать строку поиска?
For i = 1 To UBound(MassNumber) Step 1
If MassZnach(i) = "" Then
Else
If searchrow = "" Then
searchrow = Chr(34) & MassNumber(i) & " = " & MassZnach(i) & Chr(34)
Else
searchrow = searchrow & ", " & Chr(34) & MassNumber(i) & "=" & MassZnach(i) & Chr(34)
End If
End If
Next i
MsgBox searchrow
filterResult = ArrAutofilterEx(МассивПубликаций, searchrow)
Можно, - только надо немного код подправить (например, где выполняется сравнение при помощи оператора =, поставить < или >)
Добрый день Игорь!
Возможно ли отфильтровать по критерию больше или меньше?. Спасибо
Первой строкой в ваш макрос (или в мою функцию) добавьте
И снова вопрос к автору :)
Вариант решения для поиска разных значений в одном индексе нашел.
Но столкнулся с непонятной проблемой - если ищем по значению, которого нет в исходном массиве, то стопорится, ругаясь "run-time error '9' subscript out of range" на строку "ReDim newarr(1 To coll.Count, LBound(arr, 2) To UBound(arr, 2))".
Как обойти ошибку при таком раскладе? :)
Такая возможность в этой функции не предусмотрена.
Конкретно для вашего случая, - можно написать так:
А в общем случае, - никак (надо дорабатывать макрос)
Уважаемый автор, а если необходимо сделать выборку по одному и тому же номеру столбца, но с несколькими условиями?
arr = ArrAutofilterEx(Range("b12:vf21860").Value, "1=SLS6S", "1=SLS4S") - не срабатывает :(
здравствуйте, Константин.
Так будет работать:
Добрый день.
Подскажите пожалуйста, каким образом для второй функции можно организовать ввод "некого текста" по которому происходит фильтрация через InputBox?
Вариант вида:
temp = InputBox("введите некий текст")
arr = ArrAutofilterEx(Range("a2:t200").Value, "3=temp")
не работает. Начинает фильтрацию по слову temp
Спасибо.
спасибо большое, все работает как надо
Здравствуйте, Сергей.
Да, можно:
(знак вопроса обозначает 1 любой символ)
Здравствуйте, можно ли объединить две строки в одну?
arr = ArrAutofilterEx(Range("a2:d4003").Value, "1=A-PK.##")
ark = ArrAutofilterEx(Range("a2:d4003").Value, "1=A-##.##")хотелось бы чтобы находило и те и те значения.
Добрый день у меня возникла такая проблема.
Столкнулся с такой проблемой. Не знаю как подойти и как ее решить с помощью макроса. Сравнить два массива и подобрать значения.
Эти массивы все время меняются (их формирует другая программа) и по количеству столбцов они не одинаковые. Причем 1 массив является основным (эталонным). Мне нужно сравнить 1 массив со вторым. Причем со второго массива подобрать значение наиболее подходящее для значения из первого массива т.е. 590 должно подойти 600. И так для каждого значения 1 массива.
И результат вывести на другой лист.
Есть два массива
1массив 2массив
590 и 800
516 2450
1939 900
419 1200
590 600
516 500
1939 450
419 320
210
Все, понял свою ошибку:
Я в окно watches для просмотра значения массива добавлял массив из процедуры,
т.е. выделял правой клавишей переменную a() и в выскакивающем меню делал Add to watch
при этом во время работы процедуры данный массив был доступен (Context был указан как наименование данной процедуры, например, Module1.Макрос1), а при выходе a() терял свои значения и становился .
Когда же я сделал Add to watch для переменной в объявлении, т.е. Public a As Variant
Добавился массив, значения которого были доступны после запуска функции заполнения (Contex был указан, как module1).
Здравствуйте, Алексей.
Вы все правильно в коде написали, массив должен быть доступен из других макросов.
Добрый день, замечательная функция.
Подскажите, пожалуйста, возможно ли сделать, чтобы массив из функций или процедур был доступен в течение длительного времени и нескольких обращений, в т.ч. из пользовательских функций, для примера:
При открытии файла загружаем некий объем из листа в массив (10000 строк * 50)
Очень бы хотелось в дальнейшем работать с данным массивом, использовать к нему функцию фильтрования (например при обращении из пользовательской функции).
Возможно ли, чтобы этот массив не "забывался" vba и его не приходилось загружать заново?
Дело в том, что как только я выхожу из функции загрузки из range в массив (через объявление переменной variant):
public a as variant
sub p()
a= Range("a3:t10000").Value
end sub
после окончания процедуры массив a() становится недоступным
Ну так а что вы написали в параметрах фильтрации?
Вы оставляете строки, в которых первый столбец равен «Week Starting From», и первый же столбец ничему не равен...
Как такое может быть?
1) если используете 2 фильтра - они должны быть для разных столбцов
2) если применяете фильтр - надо указывать значение после знака =
PS: Если функция работала неделю назад - значит, проблема явно не в ней.
Добрый вечер. Несколько дней назад функция работала, сейчас ругается "error 13. Type dismatch" на строчку:
If Not (arr(i, ComparedColumn) Like res) Then OK = False: Exit For (выделяет до слова OK).
Для запуска функции использую следующий Sub:
Sub Filter()
Dim arr As Variant, i As Long, a As String, b As String, arr2 As Variant
a = "1=Week Starting From"
b = "1="
arr = Sheets("Details").UsedRange.Value
arr2 = ArrAutofilterEx(arr, a, b)
Cells.Select
Selection.Delete Shift:=xlUp
[a1].Resize(UBound(arr2, 1), UBound(arr2, 2)).Value = arr2
End Sub
Спасибо
Большое спасибо
Никита, в которой функции?
Вообще, отключение ошибок рулит)
Желательно эту же строку дописать ещё в начало функции
(а не только в свой макрос, перед вызовом функции)
Код может выглядеть так:
Игорь, подскажите пожалуйста, как отключить сообщение об ошибке при получении на выходе пустого массива?
Хорошо, в ближайшее время сделаю пример.
На самом деле, функция очень полезная, если часто пишете макросы.
Я использую эту функцию в 40-50% всех своих макросов.
Вкратце, как ей пользоваться: (речь про функцию ArrAutofilterEx, возвращающую отфильтрованный массив. Первая функция, ArrAutofilter, крайне редко когда может пригодиться)
1) считываем данные в массив:
arr = range("a2:f100").ValueТаким образом, мы получили двумерный массив arr из 99 строк и 6 столбцов
2) Теперь наша задача - оставить в массиве только те строки,
где в первом столбце содержится текст «товар», в 4 столбце находится значение «Да»,
а значение 6-го столбца совпадает со значением переменной txt.
С использованием функции ArrAutofilterEx, это делается при помощи одной строки кода:
В результате, в массиве arr останется не 99 строк, а, к примеру, только 40 (подходящих под все 3 условия).
3) Выгружаем результат из массива arr на другой лист, или используем в расчётах.
Добрый день!
Присоединяюсь к вопросу Алексея - можно посмотреть работу второй функции на примере? Постоянно выдает "type mismatch"
Как полльзоваться этой функцией?
Здравствуйте, можно посмотреть файл с примером где используется вторая функция? У меня она постоянно выдает ошибку "Это не массив!" при попытке выделить массив.
Понял, спасибо за информацию. Принял к сведению
А что вы понимаете под критерием? Номер столбца для сортировки?
Так для этого есть отдельный макрос сортировки
Добрый день Игорь, а как сделать функцию по сортировке строк массива с помощью одного критерия? Предположим вводить его через InputBox. Я думаю это было бы интересно и другим читателям. Очень интересный сайт. Спасибо
Отправить комментарий