Поиск подходящих строк в двумерном массиве

Данная функция ищет в массиве все строки, подходящие под заданные критерии, и возвращает результат в виде отфильтрованного массива:

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

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Иван, попробуйте заменить строку

If Not (arr(i, ComparedColumn) Like res) Then OK = False: Exit For

на что-то типа такого
If isnull(arr(i, ComparedColumn)) or (Not (arr(i, ComparedColumn) Like res)) Then OK = False: Exit For

Отличная функция. Есть вопрос. У меня в двухмерном массиве есть элементы равные 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)

Можно, - только надо немного код подправить (например, где выполняется сравнение при помощи оператора =, поставить < или >)

Добрый день Игорь!
Возможно ли отфильтровать по критерию больше или меньше?. Спасибо

Первой строкой в ваш макрос (или в мою функцию) добавьте

On Error Resume Next

И снова вопрос к автору :)
Вариант решения для поиска разных значений в одном индексе нашел.
Но столкнулся с непонятной проблемой - если ищем по значению, которого нет в исходном массиве, то стопорится, ругаясь "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=SLS[46]S")

А в общем случае, - никак (надо дорабатывать макрос)

Уважаемый автор, а если необходимо сделать выборку по одному и тому же номеру столбца, но с несколькими условиями?
arr = ArrAutofilterEx(Range("b12:vf21860").Value, "1=SLS6S", "1=SLS4S") - не срабатывает :(

здравствуйте, Константин.
Так будет работать:

arr = ArrAutofilterEx(Range("a2:t200").Value, "3=" & temp)

Добрый день.
Подскажите пожалуйста, каким образом для второй функции можно организовать ввод "некого текста" по которому происходит фильтрация через InputBox?
Вариант вида:
temp = InputBox("введите некий текст")
arr = ArrAutofilterEx(Range("a2:t200").Value, "3=temp")
не работает. Начинает фильтрацию по слову temp
Спасибо.

спасибо большое, все работает как надо

Здравствуйте, Сергей.
Да, можно:

arr = ArrAutofilterEx(Range("a2:d4003").Value, "1=A-??.##")

(знак вопроса обозначает 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() становится недоступным

Ну так а что вы написали в параметрах фильтрации?

a = "1=Week Starting From"
b = "1="

Вы оставляете строки, в которых первый столбец равен «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

Спасибо

Большое спасибо

Никита, в которой функции?
Вообще, отключение ошибок рулит)

On Error Resume Next 

Желательно эту же строку дописать ещё в начало функции
(а не только в свой макрос, перед вызовом функции)

Код может выглядеть так:

On Error Resume Next 
arr="": arr = ArrAutofilterEx(arr, "1=*товар*", "4=Да", "6=" & txt)
if not isarray(arr) then exit sub ' строк не нашлось...

' а тут код работы с выборкой (массив arr точно не пустой)

Игорь, подскажите пожалуйста, как отключить сообщение об ошибке при получении на выходе пустого массива?

Хорошо, в ближайшее время сделаю пример.

На самом деле, функция очень полезная, если часто пишете макросы.
Я использую эту функцию в 40-50% всех своих макросов.

Вкратце, как ей пользоваться: (речь про функцию ArrAutofilterEx, возвращающую отфильтрованный массив. Первая функция, ArrAutofilter, крайне редко когда может пригодиться)

1) считываем данные в массив:

arr = range("a2:f100").Value

Таким образом, мы получили двумерный массив arr из 99 строк и 6 столбцов

2) Теперь наша задача - оставить в массиве только те строки,
где в первом столбце содержится текст «товар», в 4 столбце находится значение «Да»,
а значение 6-го столбца совпадает со значением переменной txt.
С использованием функции ArrAutofilterEx, это делается при помощи одной строки кода:

arr = ArrAutofilterEx(arr, "1=*товар*", "4=Да", "6=" & txt)

В результате, в массиве arr останется не 99 строк, а, к примеру, только 40 (подходящих под все 3 условия).

3) Выгружаем результат из массива arr на другой лист, или используем в расчётах.

Добрый день!
Присоединяюсь к вопросу Алексея - можно посмотреть работу второй функции на примере? Постоянно выдает "type mismatch"

Как полльзоваться этой функцией?

Здравствуйте, можно посмотреть файл с примером где используется вторая функция? У меня она постоянно выдает ошибку "Это не массив!" при попытке выделить массив.

Понял, спасибо за информацию. Принял к сведению

А что вы понимаете под критерием? Номер столбца для сортировки?

Так для этого есть отдельный макрос сортировки

Добрый день Игорь, а как сделать функцию по сортировке строк массива с помощью одного критерия? Предположим вводить его через InputBox. Я думаю это было бы интересно и другим читателям. Очень интересный сайт. Спасибо

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
         _      _____          _____   _     
___ | | __ |_ _| _ __ | ____| | |__
/ _ \ | |/ / | | | '__| | _| | '_ \
| __/ | < | | | | | |___ | |_) |
\___| |_|\_\ |_| |_| |_____| |_.__/
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.