Function Filter2DArray(ByVal sArray, ByVal ColIndex As Long, ByVal FindStr As String, ByVal HasTitle As Boolean) | |
'sArray: mảng 2 chiều trên sheet | |
'colIndex: cột cần lọc | |
'FindStr: dữ liệu cần lọc | |
'HasTitle: Mảng nguồn có tiêu đề hay không | |
Dim TmpArr, i As Long, j As Long, Arr, Dic, TmpStr, Tmp, Chk As Boolean, TmpVal As Double | |
On Error Resume Next | |
Set Dic = CreateObject("Scripting.Dictionary") | |
TmpArr = sArray | |
ColIndex = ColIndex + LBound(TmpArr, 2) - 1 | |
Chk = (InStr("><=", Left(FindStr, 1)) > 0) | |
For i = LBound(TmpArr, 1) - HasTitle To UBound(TmpArr, 1) | |
If Chk And FindStr <> "" Then | |
TmpVal = CDbl(TmpArr(i, ColIndex)) | |
If Evaluate(TmpVal & FindStr) Then Dic.Add i, "" | |
Else | |
If Left(FindStr, 1) = "!" Then | |
If Not (UCase(TmpArr(i, ColIndex)) Like UCase(Mid(FindStr, 2, Len(FindStr)))) Then Dic.Add i, "" | |
Else | |
If UCase(TmpArr(i, ColIndex)) Like UCase(FindStr) Then Dic.Add i, "" | |
End If | |
End If | |
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 | |
For j = LBound(TmpArr, 2) To UBound(TmpArr, 2) | |
Arr(i, j) = TmpArr(Tmp(i - LBound(TmpArr, 1) + HasTitle), 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 | |
End Function | |
'Nguồn: GPE |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment