Главная » Макросы для Excel » Поиск подходящих строк в двумерном массиве

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

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

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

  • 46551 просмотр

Комментарии

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

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".
Игорь (администратор сайта), 15 Апр 2024 - 21:44.#1

Евгений, достаточно было первой строкой в модуле с кодом написать

Option Compare Text

Евгений, 15 Апр 2024 - 19:36.#2

Уже сделал
If Not StrConv((Arr(i, Filters(j&, 1))), vbLowerCase) Like _
StrConv((Filters(j&, 2)), vbLowerCase) Then arrCheck(i) = _
False: Exit For 'StrConv((...), vbLowerCase) перевод всех букв в нижний регистр
Может кому пригодится...

Евгений, 15 Апр 2024 - 19:01.#3

Очень полезная и удобная функция.Спасибо!
Один вопрос - как сделать её нечувствительной к регистру букв?

Евгений, 23 Мар 2023 - 23:37.#4

Зашёл написать что уже разобрался) Спасибо за хороший фильтр и быстрый ответ

Игорь (администратор сайта), 23 Мар 2023 - 20:34.#5

Евгений, нужно просто соблюдать синтаксис VBA:

arr = ArrAutofilterNew(arr, "1=" & i)

Евгений, 23 Мар 2023 - 20:03.#6

Здравствуйте. А как то можно заставить его принимать i из цикла for за один из параметров фильтрации? Фильтрация массива у меня происходит как раз в цикле и i для моей цели идеально бы подошел.
Например: arr = ArrAutofilterNew(arr, "1=i")
Выдает ошибку type missmatch. Если вручную туда вписывать 1, то работает, но это уже не то.

Гость, 16 Апр 2021 - 19:14.#7

UPD. Разогнал поиск и сопоставление с нескольких часов до нескольких минут для 800к+ записей в одном массиве и 365к+ в другом. если кому интересно - могу поделиться наработками.

Сергей, 14 Апр 2021 - 14:02.#8

Игорь, добрый день.
Доработал Ваш код под свои потребности и дополнительно сделал следующее (как говорил ранее, требуется сопоставление довольно больших массивов):
1. перед вызовом функции формирую временный массив, в котором содержится только 2 колонки: колонка со значениями и колонка с номером строки в исходном массиве.
2. при поиске в функции добавляю в отдельную коллекцию найденные значения (номера строк).
3. если количество найденных элементов более 250 - применяю Ваш способ формирования итогового массива на выходе из функции (т.е. перебором по временному массиву), иначе перебор идет по коллекции. При сотнях тысяц записей прирост по скорости ощутимый. В исходном (из п.1) массиве найденные строки очищаю от значений.
4. после обработки заданного количества строк (например, 5000-10000) удаляю из массива (п.1) пустые строки. Удаление производится перебором (через промежуточный массив), но это позволяет сократить время обработки. Если при первом запуске на 50000 сопоставленных строк тратится 4584 секунды, то после 250 000 - 365 секунд (365 000 записей сопоставлял с 596 000, на все про все ушло порядка 3 часов, при том что если делать сопоставление "в лоб" - потребуется более 7 часов).
Код обработки получился объемный, но попробую как пример сделать лайтовую версию (безусловно, если интересует).
Но без Вас вряд ли смог сделать нормальное решение. Спасибо.

Сергей, 9 Апр 2021 - 20:38.#9

Игорь, доброго времени суток.
Вариант фильтрации массива реализован достойно, но не проще ли сразу номера нужных строк загонять, например, в коллекцию либо словарь и потом на основании сформированного перечня выдавать результирующий массив с нужными строками (чтобы не бегать по исходному массиву несколько раз)? единственное НО - в случае с коллекцией есть ограничение порядка 250 записей (получено опытным путем, в документации не нашел такого).
Так же есть проблема с выводом значений, если найдена всего одна строка - итоговый массив не совсем некорректно формируется (не исключаю, что мои кривые ручки/параметры Excel виноваты, но факт остается фактом и для обхода данного "ограничения") немного поправил строчку: ReDim newarr(RowsCount&, UBound(arr, 2)) (безусловно, в таком случае образуется пустая нулевая строчка, но её можно легко пропустить при дальнейшей обработке результатов (для перфекционистов Redim Preserve в помощь, но оно того не стоит)).

P.S. для моей задачи требуется сравнение двух массивов, в одном порядка 365 000 записей, в другом примерно 800 000 записей (причем сверка производится трижды и тупой перебор через For...Next в лоб слишком медленно отрабатывает, соотношение записей один ко многим). Вариант с формированием поисковой текстовой строки не рассматриваю ибо её размер будет похож на мемуары (сравнение производится по текстовым значениям, индексов нет, при этом в "малом" массиве размер каждого значения около 65 знаков, в "большом" - порядка 130-180 символов)... Собственно по этой причине и подыскиваю оптимальное решение (Ваше в ТОПе).

Игорь (администратор сайта), 13 Апр 2019 - 19:12.#10

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

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

Иван, 13 Апр 2019 - 16:57.#11

Отличная функция. Есть вопрос. У меня в двухмерном массиве есть элементы равные Null (получаю массив из рекордсета). И эта функция отбирает строки с этими элементами в новый массив.
Т.е. например две строки массива
15 Труба 89
18 Задвижка Null

условие "2=89". Ожидаю отфильтрует и выведет только первую строку, а получаю и первую, и вторую.
я так понимаю, что получается "Null Like 89" и это обрабатывается как True? Как изменить код?

Александр, 17 Июн 2016 - 17:18.#12

В итоге поиск "?" по столбцу в массиве так и не заработал, как я ни бился.
"~" не помогает как и писал ранее.
Решил вопрос путем создания следующего алгоритма:
1. Поиск "?" в массиве и замена на "\".
2. Фильтрация массива по "\".
3. Замена "\" обратно на "?".
4. Вывод результатов.

Александр, 8 Июн 2016 - 19:50.#13

В ячейке указан ? + или -.
Если в качестве критерия поиска по столбцу указываешь 1=~? функция не работает

Игорь (администратор сайта), 8 Июн 2016 - 19:43.#14

Чтобы найти текст 123*456?789
ищите такое значение: 123~*456~?789
(добавляем тильду ~ перед спецсимволами типа * и ?)

Александр, 8 Июн 2016 - 19:19.#15

Добрый день!
Прошу прощения за сумбурные сообщения. Осваиваю VBA..
Все же не подскажете, как с помощью функции либо другого метода можно найти ? или * в значениях массива?

Александр, 1 Июн 2016 - 17:54.#16

Разобрался. В качестве параметров сьедает массив.
А как быть с поисков вопросительного знака в массиве?
~ не работает..

Александр, 1 Июн 2016 - 13:04.#17

Добрый день!
Пользователь вводит критерии поиска в форму.
Номер выбранного столбца и критерий поиска сохраняются в два массива.
Просматривая оба массива формирую строку поиска. Пробовал формировать ее по разному и с кавычками и без.
Так и не могу понять как нужно. Подскажите, как корректно сформировать строку поиска?
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)

Игорь (администратор сайта), 26 Май 2015 - 19:44.#18

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

Гость, 26 Май 2015 - 13:42.#19

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

Игорь (администратор сайта), 16 Мар 2015 - 07:48.#20

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

On Error Resume Next

Powerdrive, 16 Мар 2015 - 06:45.#21

И снова вопрос к автору :)
Вариант решения для поиска разных значений в одном индексе нашел.
Но столкнулся с непонятной проблемой - если ищем по значению, которого нет в исходном массиве, то стопорится, ругаясь "run-time error '9' subscript out of range" на строку "ReDim newarr(1 To coll.Count, LBound(arr, 2) To UBound(arr, 2))".
Как обойти ошибку при таком раскладе? :)

Игорь (администратор сайта), 15 Мар 2015 - 09:53.#22

Такая возможность в этой функции не предусмотрена.
Конкретно для вашего случая, - можно написать так:

arr = ArrAutofilterEx(Range("b12:vf21860").Value, "1=SLS[46]S")

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

Powerdrive, 15 Мар 2015 - 05:22.#23

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

Игорь (администратор сайта), 10 Июл 2014 - 18:03.#24

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

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

Константин, 10 Июл 2014 - 15:19.#25

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

Серей, 24 Янв 2014 - 17:37.#26

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

Игорь (администратор сайта), 23 Янв 2014 - 00:06.#27

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

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

(знак вопроса обозначает 1 любой символ)

Серей, 22 Янв 2014 - 23:44.#28

Здравствуйте, можно ли объединить две строки в одну?
arr = ArrAutofilterEx(Range("a2:d4003").Value, "1=A-PK.##")
ark = ArrAutofilterEx(Range("a2:d4003").Value, "1=A-##.##")хотелось бы чтобы находило и те и те значения.

Гость, 16 Авг 2013 - 10:57.#29

Добрый день у меня возникла такая проблема.
Столкнулся с такой проблемой. Не знаю как подойти и как ее решить с помощью макроса. Сравнить два массива и подобрать значения.
Эти массивы все время меняются (их формирует другая программа) и по количеству столбцов они не одинаковые. Причем 1 массив является основным (эталонным). Мне нужно сравнить 1 массив со вторым. Причем со второго массива подобрать значение наиболее подходящее для значения из первого массива т.е. 590 должно подойти 600. И так для каждого значения 1 массива.
И результат вывести на другой лист.
Есть два массива
1массив 2массив
590 и 800
516 2450
1939 900
419 1200
590 600
516 500
1939 450
419 320
210

Алексей, 30 Апр 2013 - 05:17.#30

Все, понял свою ошибку:
Я в окно watches для просмотра значения массива добавлял массив из процедуры,
т.е. выделял правой клавишей переменную a() и в выскакивающем меню делал Add to watch
при этом во время работы процедуры данный массив был доступен (Context был указан как наименование данной процедуры, например, Module1.Макрос1), а при выходе a() терял свои значения и становился .
Когда же я сделал Add to watch для переменной в объявлении, т.е. Public a As Variant
Добавился массив, значения которого были доступны после запуска функции заполнения (Contex был указан, как module1).

Игорь (администратор сайта), 30 Апр 2013 - 00:21.#31

Здравствуйте, Алексей.
Вы все правильно в коде написали, массив должен быть доступен из других макросов.

Алексей, 29 Апр 2013 - 20:35.#32

Добрый день, замечательная функция.
Подскажите, пожалуйста, возможно ли сделать, чтобы массив из функций или процедур был доступен в течение длительного времени и нескольких обращений, в т.ч. из пользовательских функций, для примера:
При открытии файла загружаем некий объем из листа в массив (10000 строк * 50)
Очень бы хотелось в дальнейшем работать с данным массивом, использовать к нему функцию фильтрования (например при обращении из пользовательской функции).
Возможно ли, чтобы этот массив не "забывался" vba и его не приходилось загружать заново?
Дело в том, что как только я выхожу из функции загрузки из range в массив (через объявление переменной variant):

public a as variant
sub p()
a= Range("a3:t10000").Value
end sub

после окончания процедуры массив a() становится недоступным

Игорь (администратор сайта), 7 Фев 2013 - 21:53.#33

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

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

Вы оставляете строки, в которых первый столбец равен «Week Starting From», и первый же столбец ничему не равен...
Как такое может быть?

1) если используете 2 фильтра - они должны быть для разных столбцов
2) если применяете фильтр - надо указывать значение после знака =

PS: Если функция работала неделю назад - значит, проблема явно не в ней.

Владимир, 7 Фев 2013 - 21:06.#34

Добрый вечер. Несколько дней назад функция работала, сейчас ругается "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

Спасибо

Никита, 18 Окт 2012 - 16:05.#35

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

Игорь (администратор сайта), 18 Окт 2012 - 14:05.#36

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

On Error Resume Next

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

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

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

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

Никита, 18 Окт 2012 - 13:58.#37

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

Игорь (администратор сайта), 10 Окт 2012 - 17:56.#38

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

На самом деле, функция очень полезная, если часто пишете макросы.
Я использую эту функцию в 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 на другой лист, или используем в расчётах.

Никита, 10 Окт 2012 - 17:34.#39

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

Гость, 14 Сен 2012 - 17:50.#40

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

Алексей, 21 Июл 2012 - 15:34.#41

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

Антон, 27 Июл 2011 - 08:28.#42

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

Игорь (администратор сайта), 26 Июл 2011 - 16:19.#43

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

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

Антон, 26 Июл 2011 - 16:05.#44

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

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

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

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

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