Function Filter2DArray(ByVal sArray, _
ByVal ColIndex As Long, _
ByVal FindStr1 As String, _
ByVal HasTitle As Boolean, _
Optional ByVal FindStr2, _
Optional ByVal arg_and As Boolean = True)
Dim TmpVal As Double
Dim currRow As Long, i As Long, j As Long
Dim Chk As Boolean, res As Boolean
Dim sArr As String, sFind As String
Dim Dic, Arr, Tmp, TmpArr, TmpStr
On Error Resume Next
Set Dic = CreateObject("Scripting.Dictionary")
TmpArr = sArray
ColIndex = ColIndex + LBound(TmpArr, 2) - 1
If FindStr1 <> "" Then
Chk = InStr("><=", Left(FindStr1, 1)) > 0
If Not IsMissing(FindStr2) And (FindStr2 <> "") Then
Chk = Chk And (InStr("><=", Left(FindStr1, 1)) > 0)
End If
End If
For i = LBound(TmpArr, 1) - HasTitle To UBound(TmpArr, 1)
If Chk Then
TmpVal = CDbl(TmpArr(i, ColIndex))
If Err.Number = 0 Then
res = Evaluate(TmpVal & FindStr1)
If Not IsMissing(FindStr2) And (FindStr2 <> "") Then
If arg_and Then
res = res And Evaluate(TmpVal & FindStr2)
Else
res = res Or Evaluate(TmpVal & FindStr2)
End If
End If
Else
Err.Clear
End If
Else
sArr = UCase(TmpArr(i, ColIndex))
If Left(FindStr1, 1) = "!" Then
res = Not (sArr Like UCase(Mid(FindStr1, 2, Len(FindStr1))))
Else
res = sArr Like UCase(FindStr1)
End If
If Not IsMissing(FindStr2) Then
If Left(FindStr2, 1) = "!" Then
If arg_and Then
res = res And Not (sArr Like UCase(Mid(FindStr2, 2, Len(FindStr2))))
Else
res = res Or Not (sArr Like UCase(Mid(FindStr2, 2, Len(FindStr2))))
End If
Else
If arg_and Then
res = res And (sArr Like UCase(FindStr2))
Else
res = res Or (sArr Like UCase(FindStr2))
End If
End If
End If
End If
If res Then Dic.Add i, ""
Next
If Dic.Count > 0 Then
Tmp = Dic.Keys
ReDim Arr(LBound(TmpArr, 1) To UBound(Tmp) + LBound(TmpArr, 1) - HasTitle, LBound(TmpArr, 2) To UBound(TmpArr, 2))
For i = LBound(TmpArr, 1) - HasTitle To UBound(Tmp) + LBound(TmpArr, 1) - HasTitle
currRow = i - LBound(TmpArr, 1) + HasTitle
For j = LBound(TmpArr, 2) To UBound(TmpArr, 2)
Arr(i, j) = TmpArr(Tmp(currRow), j)
Next
Next
If HasTitle Then
For j = LBound(TmpArr, 2) To UBound(TmpArr, 2)
Arr(LBound(TmpArr, 1), j) = TmpArr(LBound(TmpArr, 1), j)
Next
End If
End If
Filter2DArray = Arr
Set Dic = Nothing
Erase Arr, TmpArr
End Function
