Я пытаюсь оптимизировать свою функцию FilterArray, поэтому я подумал об использовании отсортированного столбца (когда он доступен).
Исходная функция проходит по всем элементам массива, производит сравнение в различных столбцах и построить получившийся массив.
В этой новой версии я хочу уменьшить количество основных итераций l oop, найдя первую и последнюю действительные строки в отсортированном столбце, поэтому я добавил первый l oop что:
- Сравните значение в отсортированном столбце и минимальный допустимый предел
- Когда будет найдена первая действительная строка, сохраните ее и начните поиск верхнего предела
- Если верхний предел достигнут или верхняя граница достигнута, выйдите из l oop
- Перейдите к основному l oop допустимому диапазону, в котором ищите
Этот новый подход работает и может значительно сократить время выполнения, но не всегда. С интуитивной точки зрения, я могу понять, что это оптимизация, когда первое l oop уменьшается хотя бы на «немного». количество петель основного l oop .. Но ..
1- Как рассчитать, когда его удобно использовать?
I ' Я действительно не знаком с понятием сложности, но, по сути, я смог понять, что этот новый подход не уменьшает масштаб сложности, но в тех случаях, когда первый l oop работает хорошо, время выполнения заметно меньше. ..
2- Что это за оптимизация? Извините, если это не очень хороший вопрос ..
В этом первом фрагменте кода я предполагаю что порядок sortedColumn возрастает, потому что это единственный способ, которым имя переменной имеет смысл (я написал сначала для возрастающего порядка, а затем отрегулировал для обоих порядков).
Вы найдете правильный код ниже.
Вы найдете новый код для поиска в отсортированном столбце между '---------------
Заранее спасибо!
Это новая OOP версия. Класс ArrayFilter
Option Explicit
Private pColumnsToReturn As Variant
Private pFiltersCollection As Collection
Private pPartialMatchColl As Collection
Private Enum filterType
negativeMatch = -1
exactMatch = 0
isBetween = 1
contains = 2
End Enum
Public Property Let ColumnsToReturn(arr As Variant)
pColumnsToReturn = arr
End Property
Public Property Get Filters() As Collection
Set Filters = pFiltersCollection
End Property
Public Sub IncludeEquals(ByRef equalTo As Variant, ByRef inColumn As Long, _
Optional ByRef isCaseSensitive As Boolean = False)
If inColumn > -1 Then
Dim thisFilter As Collection
Dim thisFilterType As filterType
Set thisFilter = New Collection
thisFilterType = exactMatch
With thisFilter
.Add thisFilterType
.Add inColumn
.Add IIf(isCaseSensitive, equalTo, LCase(equalTo))
.Add isCaseSensitive
End With
If pFiltersCollection Is Nothing Then Set pFiltersCollection = New Collection
pFiltersCollection.Add thisFilter
Set thisFilter = Nothing
End If
End Sub
Public Sub ExcludeEquals(ByRef equalTo As Variant, ByRef inColumn As Long, _
Optional ByRef isCaseSensitive As Boolean = False)
If inColumn > -1 Then
Dim thisFilter As Collection
Dim thisFilterType As filterType
Set thisFilter = New Collection
thisFilterType = negativeMatch
With thisFilter
.Add thisFilterType
.Add inColumn
.Add IIf(isCaseSensitive, equalTo, LCase(equalTo))
.Add isCaseSensitive
End With
If pFiltersCollection Is Nothing Then Set pFiltersCollection = New Collection
pFiltersCollection.Add thisFilter
Set thisFilter = Nothing
End If
End Sub
Public Sub IncludeBetween(ByRef lowLimit As Variant, ByRef highLimit As Variant, ByRef inColumn As Long)
If inColumn > -1 Then
Dim thisFilter As Collection
Dim thisFilterType As filterType
Set thisFilter = New Collection
thisFilterType = isBetween
With thisFilter
.Add thisFilterType
.Add inColumn
.Add lowLimit
.Add highLimit
End With
If pFiltersCollection Is Nothing Then Set pFiltersCollection = New Collection
pFiltersCollection.Add thisFilter
Set thisFilter = Nothing
End If
End Sub
Public Sub IncludeIfContain(ByRef substring As String, Optional ByRef inColumns As Variant = 1)
If IsArray(inColumns) Or IsNumeric(inColumns) Then
Dim thisFilterType As filterType
Set pPartialMatchColl = New Collection
thisFilterType = contains
With pPartialMatchColl
.Add thisFilterType
.Add inColumns
.Add substring
End With
End If
End Sub
Public Sub ApplyTo(ByRef originalArray As Variant)
If Not IsArray(originalArray) Then Exit Sub
Dim firstRow As Long
Dim lastRow As Long
Dim firstColumn As Long
Dim lastColumn As Long
Dim row As Long
Dim col As Long
Dim arrayOfColumnToReturn As Variant
Dim partialMatchColumnsArray As Variant
Dim result As Variant
result = -1
arrayOfColumnToReturn = pColumnsToReturn
If Not pPartialMatchColl Is Nothing Then partialMatchColumnsArray = pPartialMatchColl(2)
' If the caller don't pass the array of column to return
' create an array with all the columns and preserve the order
If Not IsArray(arrayOfColumnToReturn) Then
ReDim arrayOfColumnToReturn(LBound(originalArray, 2) To UBound(originalArray, 2))
For col = LBound(originalArray, 2) To UBound(originalArray, 2)
arrayOfColumnToReturn(col) = col
Next col
End If
' If the caller don't pass an array for partial match
' check if it pass the special value 1, if true the
' partial match will be performed on values in columns to return
If Not IsArray(partialMatchColumnsArray) Then
If partialMatchColumnsArray = 1 Then partialMatchColumnsArray = arrayOfColumnToReturn
End If
firstRow = LBound(originalArray, 1)
lastRow = UBound(originalArray, 1)
' main loop
Dim keepCount As Long
Dim filter As Variant
Dim currentFilterType As filterType
ReDim arrayOfRowsToKeep(lastRow - firstRow + 1) As Variant
keepCount = 0
For row = firstRow To lastRow
' exact, excluse and between checks
If Not Me.Filters Is Nothing Then
For Each filter In Me.Filters
currentFilterType = filter(1)
Select Case currentFilterType
Case negativeMatch
If filter(4) Then
If originalArray(row, filter(2)) = filter(3) Then GoTo Skip
Else
If LCase(originalArray(row, filter(2))) = filter(3) Then GoTo Skip
End If
Case exactMatch
If filter(4) Then
If originalArray(row, filter(2)) <> filter(3) Then GoTo Skip
Else
If LCase(originalArray(row, filter(2))) <> filter(3) Then GoTo Skip
End If
Case isBetween
If originalArray(row, filter(2)) < filter(3) _
Or originalArray(row, filter(2)) > filter(4) Then GoTo Skip
End Select
Next filter
End If
' partial match check
If Not pPartialMatchColl Is Nothing Then
If IsArray(partialMatchColumnsArray) Then
For col = LBound(partialMatchColumnsArray) To UBound(partialMatchColumnsArray)
If InStr(1, originalArray(row, partialMatchColumnsArray(col)), pPartialMatchColl(3), vbTextCompare) > 0 Then
GoTo Keep
End If
Next
GoTo Skip
End If
End If
Keep:
arrayOfRowsToKeep(keepCount) = row
keepCount = keepCount + 1
Skip:
Next row
' create results array
If keepCount > 0 Then
firstRow = LBound(originalArray, 1)
lastRow = LBound(originalArray, 1) + keepCount - 1
firstColumn = LBound(originalArray, 2)
lastColumn = LBound(originalArray, 2) + UBound(arrayOfColumnToReturn) - LBound(arrayOfColumnToReturn)
ReDim result(firstRow To lastRow, firstColumn To lastColumn)
For row = firstRow To lastRow
For col = firstColumn To lastColumn
result(row, col) = originalArray(arrayOfRowsToKeep(row - firstRow), arrayOfColumnToReturn(col - firstColumn + LBound(arrayOfColumnToReturn)))
Next col
Next row
End If
originalArray = result
If IsArray(result) Then Erase result
End Sub
Код с обоими порядками сортировки:
Function FilterArray(ByVal originalArray As Variant, _
Optional arrayOfColumnToReturn As Variant, _
Optional sortedColumn As Integer = -1, Optional IsAscendingSorted As Boolean, Optional sortedColumnLowValue As Variant, Optional sortedColumnHighValue As Variant, _
Optional firstExactMatchColumn As Integer = -1, Optional firstExactMatchValue As Variant, _
Optional secondExactMatchColumn As Integer = -1, Optional secondExactMatchValue As Variant, _
Optional thirdExactMatchColumn As Integer = -1, Optional thirdExactMatchValue As Variant, _
Optional firstColumnToExclude As Integer = -1, Optional firstValueToExclude As Variant, _
Optional secondColumnToExclude As Integer = -1, Optional secondValueToExclude As Variant, _
Optional thirdColumnToExclude As Integer = -1, Optional thirdValueToExclude As Variant, _
Optional firstColumnIsBetween As Integer = -1, Optional firstLowValue As Variant, Optional firstHighValue As Variant, _
Optional secondColumnIsBetween As Integer = -1, Optional secondLowValue As Variant, Optional secondHighValue As Variant, _
Optional thirdColumnIsBetween As Integer = -1, Optional thirdLowValue As Variant, Optional thirdHighValue As Variant, _
Optional partialMatchColumnsArray As Variant = -1, Optional partialMatchValue As Variant) As Variant
FilterArray = -1
If Not IsArray(originalArray) Then Exit Function
Dim firstRow As Long
Dim lastRow As Long
Dim firstColumn As Long
Dim lastColumn As Long
Dim row As Long
Dim col As Long
Dim filteredArrayRow As Long
Dim partialCol As Long
' If the caller don't pass the array of column to return I create an array with all the columns and I preserve the order
If Not IsArray(arrayOfColumnToReturn) Then
ReDim arrayOfColumnToReturn(LBound(originalArray, 2) To UBound(originalArray, 2))
For col = LBound(originalArray, 2) To UBound(originalArray, 2)
arrayOfColumnToReturn(col) = col
Next col
End If
firstRow = LBound(originalArray, 1)
lastRow = UBound(originalArray, 1)
firstColumn = LBound(arrayOfColumnToReturn)
lastColumn = UBound(arrayOfColumnToReturn)
' If the caller don't pass an array for partial match check if it pass the special value 1, if true the partial macth will be performed on values in columns to return
If Not IsArray(partialMatchColumnsArray) Then
If partialMatchColumnsArray = 1 Then partialMatchColumnsArray = arrayOfColumnToReturn
End If
ReDim tempFilteredArray(firstColumn To lastColumn, firstRow To firstRow) As Variant
filteredArrayRow = firstRow - 1
'-------------------------------------------------------------------------------------------------------------------
If sortedColumn > -1 Then
Dim ImSearchingForLowLine As Boolean
Dim lowRow As Long
Dim highRow As Long
highRow = IIf(IsAscendingSorted, lastRow, firstRow) 'Set default values that won't allow to run the Main loop if First loop don't change them.
lowRow = IIf(IsAscendingSorted, lastRow + 1, firstRow - 1)
ImSearchingForLowLine = True
'First loop
'Depending from the sorting order, loop from FirstToLast or LastToFirst
For row = IIf(IsAscendingSorted, firstRow, lastRow) To IIf(IsAscendingSorted, lastRow, firstRow) Step IIf(IsAscendingSorted, 1, -1)
If ImSearchingForLowLine Then
If originalArray(row, sortedColumn) < sortedColumnLowValue Then
GoTo NextRow
Else
'This second check is needed to avoid false positive.
If originalArray(row, sortedColumn) <= sortedColumnHighValue Then
'Now I've found the first valid row, I store it and start search for last valid row
lowRow = row
ImSearchingForLowLine = False
End If
End If
Else
If originalArray(row, sortedColumn) > sortedColumnHighValue Then
'Now row is the first invalid row.
highRow = row + IIf(IsAscendingSorted, -1, 1)
Exit For
Else
GoTo NextRow
End If
End If
NextRow:
Next row
firstRow = IIf(IsAscendingSorted, lowRow, highRow)
lastRow = IIf(IsAscendingSorted, highRow, lowRow)
End If
'-------------------------------------------------------------------------------------------------------------------
'Main Loop
For row = firstRow To lastRow
' Start Exact Match check
If firstExactMatchColumn > -1 Then
If LCase(originalArray(row, firstExactMatchColumn)) <> LCase(firstExactMatchValue) Then GoTo SkipRow
End If
If secondExactMatchColumn > -1 Then
If LCase(originalArray(row, secondExactMatchColumn)) <> LCase(secondExactMatchValue) Then GoTo SkipRow
End If
If thirdExactMatchColumn > -1 Then
If LCase(originalArray(row, thirdExactMatchColumn)) <> LCase(thirdExactMatchValue) Then GoTo SkipRow
End If
' End Exact Match check
' Start Negative Match check
If firstColumnToExclude > -1 Then
If LCase(originalArray(row, firstColumnToExclude)) = LCase(firstValueToExclude) Then GoTo SkipRow
End If
If secondColumnToExclude > -1 Then
If LCase(originalArray(row, secondColumnToExclude)) = LCase(secondValueToExclude) Then GoTo SkipRow
End If
If thirdColumnToExclude > -1 Then
If LCase(originalArray(row, thirdColumnToExclude)) = LCase(thirdValueToExclude) Then GoTo SkipRow
End If
' End Negative Match check
' Start isBetween check
If firstColumnIsBetween > -1 Then
If originalArray(row, firstColumnIsBetween) < firstLowValue Or originalArray(row, firstColumnIsBetween) > firstHighValue Then GoTo SkipRow
End If
If secondColumnIsBetween > -1 Then
If originalArray(row, secondColumnIsBetween) < secondLowValue Or originalArray(row, secondColumnIsBetween) > secondHighValue Then GoTo SkipRow
End If
If thirdColumnIsBetween > -1 Then
If originalArray(row, thirdColumnIsBetween) < thirdLowValue Or originalArray(row, thirdColumnIsBetween) < thirdHighValue Then GoTo SkipRow
End If
' End isBetween check
' Start partial match check
If IsArray(partialMatchColumnsArray) Then
For partialCol = LBound(partialMatchColumnsArray) To UBound(partialMatchColumnsArray)
If InStr(1, originalArray(row, partialMatchColumnsArray(partialCol)), partialMatchValue, vbTextCompare) > 0 Then
GoTo WriteRow
End If
Next partialCol
GoTo SkipRow
End If
' End partial match check
WriteRow:
' Writing data in the filtered array
filteredArrayRow = filteredArrayRow + 1
ReDim Preserve tempFilteredArray(firstColumn To lastColumn, LBound(tempFilteredArray, 1) To filteredArrayRow)
For col = firstColumn To lastColumn
tempFilteredArray(col, filteredArrayRow) = originalArray(row, arrayOfColumnToReturn(col))
Next col
SkipRow:
Next row
If filteredArrayRow > LBound(tempFilteredArray, 1) - 1 Then
FilterArray = InvertiMatrice(tempFilteredArray) 'This is similar to Application.Transpose
End If
Erase originalArray
Erase arrayOfColumnToReturn
If IsArray(partialMatchColumnsArray) Then Erase partialMatchColumnsArray
If IsArray(tempFilteredArray) Then Erase tempFilteredArray
End Function
При необходимости это код функции InvertiMatrice. Цель состоит в том, чтобы инвертировать строки и столбцы в двумерном массиве.
Function InvertiMatrice(originalArray As Variant) As Variant
InvertiMatrice = -1
If Not IsArray(originalArray) Then Exit Function
Dim row As Long
Dim column As Long
Dim firstRow As Long
Dim lastRow As Long
Dim firstColumn As Long
Dim lastColumn As Long
firstRow = LBound(originalArray, 1)
firstColumn = LBound(originalArray, 2)
lastRow = UBound(originalArray, 1)
lastColumn = UBound(originalArray, 2)
ReDim tempArray(firstColumn To lastColumn, firstRow To lastRow) As Variant
For row = firstColumn To lastColumn
For column = firstRow To lastRow
tempArray(row, column) = originalArray(column, row)
Next column
Next row
InvertiMatrice = tempArray
Erase originalArray
Erase tempArray
End Function