Данная функция ищет в массиве все строки, подходящие под заданные критерии, и возвращает результат в виде отфильтрованного массива:
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
Комментарии
Иван, попробуйте заменить строку
на что-то типа такого
Отличная функция. Есть вопрос. У меня в двухмерном массиве есть элементы равные 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. Я думаю это было бы интересно и другим читателям. Очень интересный сайт. Спасибо
Отправить комментарий