ArrayFilterV

Авторские программы и библиотеки от Bedvit

BEDVIT.NAROD.RU

Мой старый сайт и зеркало-архив (осторожно, на сайте реклама!)

BedvitCOM.ArrayFilterV

Инструмент для фильтрации одномерного и двухмерного СОМ-массива (тип данных VARIANT) для любого количества столбцов, с любым количеством условий.

Реализован параллельный алгоритм фильтрации (поддержка любого количества логических процессоров).
Часть библиотеки BedvitCOM (начиная с v2.0.1.0, в XLL c v3.2.1.0)

ArrayFilterV(VARIANT* array_in, VARIANT* array_parameters, VARIANT_BOOL array_out_index, VARIANT* array_out)
1. array_in - массив входящий (одномерный, двухмерный), тип данных VARIANT.
2. array_parameters - массив задаваемых параметров, тип данных VARIANT (6 параметров для одного условия, можно для одного и того же столбца, можно для разных). Количество условий не ограничено. Условия можно создать из списка, можно создать двухмерный массив и заполнить, можно забрать сразу с листа Excel.
3. array_out_index - режим вывода: 0- отфильтрованный массив, 1-массив индексов
4. array_out - массив результатов

Условия в массиве параметров применяются в порядке следования, если нет скобок или внутри скобок. Скобки задают приоритет выполнения условий (стандартно), потом "И" и "ИЛИ" в порядке очередности.
Параметры массива условий (сделал максимально близко к стандартной записи условий) - 6 параметров для каждой строки условия:
1.Логические операторы (0-ИЛИ, 1-И). Для первого условия можно не указывать.
2.Скобки открывающие (если нужны, можно несколько)
3.Столбец для фильтрации
4.Операторы сравнения (для сравнения значения заданного столбца со значением фильтра):

1 - меньше (для числа),

2 - равно (для числа и строки),

4 - больше (для числа),

8 - содержит подстроку (для строки),

16 - зарезервированное значение (регулярки),

32 - игнорировать регистр (для строки) ,

64 - зарезервированное значение (basic),

128 - зарезервированное значение (extended),

256 - LIKE (пока только знак подстановки "*")(для строки), (начиная с v3.5, в XLL c v4.6) полноценный Like (бинарный режим)

512-НЕ (для числа и строки)

Реализовано в виде бинарной маски, т.е. можно складывать, к примеру 8+512 - НЕ содержит подстроку, 1+2 - меньше или равно и т.д.
5.Значение фильтра (для фильтрации)
6.Скобки закрывающие (если нужны, можно несколько)

т.е. для каждого условия 6 параметров: И/ИЛИ,(((...,стобец, оператор сравнения, значение, ...)))

Условия можно задавать как простые:
'фильтр по первому столбцу, значение = 9
Array(,,1, 2, 9, "")

так и более сложные, к примеру

Array(,"(((", 1, Содержит, "маша", , ИЛИ, , 1, Содержит, "вася", ")", И, , 1, НеРавно, "маша иванова", ")", ИЛИ, "(", 2, НеРавно, "'1", , ИЛИ, , 2, Равно, 1, "))", И, "(", 3, БольшеРавно, 12.5, , И, , 3, МеньшеРавно, 55.8, ")")
или в таком виде (как удобнее). В примере для операторов сравнения созданы псевдонимы (в виде слова, по факту это банарная маска, см. выше)
Array( _
,"(((", 1, Содержит, "маша", , _
ИЛИ, , 1, Содержит, "вася", ")", _
И, , 1, НеРавно, "маша иванова", ")", _
ИЛИ, "(", 2, НеРавно, "'1", , _
ИЛИ, , 2, Равно, 1, "))", _
И, "(", 3, БольшеРавно, 12.5, , _
И, , 3, МеньшеРавно, 55.8, ")" _
)

Тайминги: фильтрация 10 млн. строк с найденными 5 млн. = 0,2 секунды

Примеры: простые (с замером скорости на 10 млн строк) и сложные (с выводом условий и результата):
[VBA]

Option Explicit

'операторы (aliases) псевдонимы

Const ИЛИ = 0, И = 1, РАВНО = 2, СОДЕРЖИТ = 8, НЕРАВНО = 512 + 2, МЕНЬШЕРАВНО = 1 + 2, БОЛЬШЕРАВНО = 4 + 2, МЕНЬШЕ = 1, БОЛЬШЕ = 4

'ОДНОМЕРНЫЙ МАССИВ, ПРОСТЫЕ УСЛОВИЯ, бинарная маска без слова-псевдонима

Sub TestArrayFilterV_1()

'Dim bVBA As New BedvitCOM.VBA 'раннее связывание

Dim bVBA As Object: Set bVBA = CreateObject("BedvitCOM.VBA") 'позднее связывание

Dim arrResult

'первоначальный массив данных

Dim arrV: arrV = Array(1, 0, 1, 0, 1, 0)

'массив условий (фильтр по первому столбцу, значение = 1)

Dim p: p = Array(, , 1, 2, 1, "")

' фильтруем ===============================

bVBA.ArrayFilterV arrV, p, 0, arrResult

'========================================

Debug.Print UBound(arrResult) + 1 'начало с 0

End Sub

'ДВУХМЕРНЫЙ МАССИВ, ПРОСТЫЕ УСЛОВИЯ, бинарная маска в виде слова-псевдонима

Sub TestArrayFilterV_2()

'Dim bVBA As New BedvitCOM.VBA 'раннее связывание

Dim bVBA As Object: Set bVBA = CreateObject("BedvitCOM.VBA") 'позднее связывание

Dim arrResult, r, c, t, x

Dim sizeRow As Long: sizeRow = 10000000

Dim sizeCol As Long: sizeCol = 1

Dim arrV: ReDim arrV(1 To sizeRow, 1 To sizeCol) 'первоначальный массив данных, далее хаполняем рендомно

'массив условий (фильтр по первому столбцу, значение = 1)

Dim p: p = Array(, , 1, РАВНО, 1, "")

'заполняем первоначальный массив с данными

For r = 1 To sizeRow

For c = 1 To sizeCol

arrV(r, c) = CLng(Rnd * 2)

t = Timer

' фильтруем ===============================

bVBA.ArrayFilterV arrV, p, 0, arrResult

'========================================

Debug.Print Timer - t

Debug.Print UBound(arrResult) + 1 'начало с 0

End Sub

'ДВУХМЕРНЫЙ МАССИВ, СЛОЖНЫЕ УСЛОВИЯ, бинарная маска в виде слова-псевдонима

Sub TestArrayFilterV_3()

Dim arrParam, arrTest, arrRes, bCOMvba As Object: Set bCOMvba = CreateObject("BedvitCOM.VBA")

Cells.ClearContents

'создаем тестовый массив

arrTest = Array("маша иванова", "'1", 13, "маша иванова", 1, 13, "маша", "'1", 14, "вася", "'1", 14, "паша", 1, 50, "вася", 2, 52, "маша", 1, 60, "вася", 1, 65)

bCOMvba.Array1Dto2D arrTest, 1, 1, UBound(arrTest) / 3: bCOMvba.Transpose arrTest

Cells(1, 1).Resize(UBound(arrTest, 1), UBound(arrTest, 2)) = arrTest

'запись условий для фильтра:(((c1 like "маша" or like "вася") and c1<>"маша иванова") or (c2<>"1" or c2=1)) and (c3>=12,5 and c3<=55,8)

arrParam = Array(, "(((", 1, СОДЕРЖИТ, "маша", , ИЛИ, , 1, СОДЕРЖИТ, "вася", ")", И, , 1, НЕРАВНО, "маша иванова", ")", ИЛИ, "(", 2, НЕРАВНО, "'1", , ИЛИ, , 2, РАВНО, 1, "))", И, "(", 3, БОЛЬШЕРАВНО, 12.5, , И, , 3, МЕНЬШЕРАВНО, 55.8, ")")

'ИЛИ ТАК

arrParam = Array( _

, "(((", 1, СОДЕРЖИТ, "маша", , _

ИЛИ, , 1, СОДЕРЖИТ, "вася", ")", _

И, , 1, НЕРАВНО, "маша иванова", ")", _

ИЛИ, "(", 2, НЕРАВНО, "'1", , _

ИЛИ, , 2, РАВНО, 1, "))", _

И, "(", 3, БОЛЬШЕРАВНО, 12.5, , _

И, , 3, МЕНЬШЕРАВНО, 55.8, ")" _

)

bCOMvba.Array1Dto2D arrParam, 1, 1, UBound(arrParam) / 6: bCOMvba.Transpose arrParam

Cells(1, 5).Resize(UBound(arrParam, 1), UBound(arrParam, 2)) = arrParam