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)
' sArray là mảng - range chứa các giá trị cần lọc
' ColIndex là chỉ số cột mà các giá trị ở đấy sẽ được lọc. Chỉ số này được tính từ 1 bất kể chỉ số sArray được tính từ bao nhiêu.
' vd. ta truyền mảng sArray thực chất là mảng sArray(4 to 35, 5 to 10) mà ta muốn lọc theo cột thứ 2 thì ColIndex = 2
' FindStr1(2) là mask để kiểm tra xem có khớp với các giá trị trong cột ColIndex hay không
' Nếu khớp thì toàn bộ dòng có chứa giá trị khớp đó sẽ được trả về
' Có 3 loại MASK
' 1. loại "><=xyz" - xyz là các chữ số
' 2. loại "!xyz" - lấy các dòng mà ở cột ColIndex không có cụm ký tự "xyz", tức loại các dòng mà ở cột ColIndex có chứa "xyz"
' 3. loại "xyz" - lấy các dòng mà ở cột ColIndex có cụm ký tự "xyz"
' HasTitle - thông báo là mảng nhập vào có chứa tiêu đề ở dòng đầu tiên (TRUE) hoặc không chứa (FALSE)
Dim TmpArr, i As Long, j As Long, Arr, Dic, TmpStr, Tmp, Chk As Boolean, TmpVal As Double, sArr As String, sFind As String, res As Boolean
Dim currRow As Long
On Error Resume Next
Set Dic = CreateObject("Scripting.Dictionary")
' sao dữ liệu từ sArray sang TmpArr
TmpArr = sArray
' ColIndex là chỉ số cột tìm kiếm trong sArray tính từ 1, cột đó trong TmpArr có chỉ số:
ColIndex = ColIndex + LBound(TmpArr, 2) - 1
' kiểm tra xem ký tự đầu tiên trong mask FindStr1 có phải là "<", ">" hay "=" không. Nếu có thì mask là loại 1, tức ta tìm và lấy
' các dòng có chứa số "abc" thỏa điều kiện abc ><=xyz.
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
' đi từng dòng trong cột lọc ColIndex và lọc lấy dữ liệu
For i = LBound(TmpArr, 1) - HasTitle To UBound(TmpArr, 1)
If Chk Then
' nếu FindStr1 là dạng ><= xyz thì đọc giá trị tại dòng hiện hành ở cột ColIndex
TmpVal = CDbl(TmpArr(i, ColIndex))
' kiểm tra lỗi vì dữ liệu đầu vào có thể chứa lỗi
If Err.Number = 0 Then
' và nếu giá trị đó là số và thỏa mãn (TmpVal ><= xyz) thì thêm chỉ số dòng hiện hành (được chọn) vào từ điển
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
' neu FindStr1 khong la dang ><= B
' nếu FinStr1 không là dạng ><=xyz thì kiểm tra xem ký tự đầu của FindStr1 có phải là "!" hay không, tức xem
' FindStr1 có dạng !xyz hay không.
sArr = UCase(TmpArr(i, ColIndex))
If Left(FindStr1, 1) = "!" Then
' FindStr có dạng "!xyz" vậy ta thêm vào từ điển chỉ số dòng hiện hành nếu giá trị ở cột ColIndex không chứa cụm "xyz"
res = Not (sArr Like UCase(Mid(FindStr1, 2, Len(FindStr1))))
Else
' FindStr không có dạng "!xyz" vậy ta thêm vào từ điển chỉ số dòng hiện hành nếu giá trị ở cột ColIndex chứa cụm "xyz"
res = sArr Like UCase(FindStr1)
End If
' nếu có thông số thứ 2
If Not IsMissing(FindStr2) Then
If Left(FindStr2, 1) = "!" Then
' FindStr2 có dạng "!xyz" vậy ta thêm vào từ điển chỉ số dòng hiện hành nếu giá trị ở cột ColIndex không chứa cụm "xyz"
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
' FindStr2 không có dạng "!xyz" vậy ta thêm vào từ điển chỉ số dòng hiện hành nếu giá trị ở cột ColIndex chứa cụm "xyz"
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
' nếu trong từ điển có dữ liệu là các chỉ số dòng được chọn thì các chỉ số đó là các Key trong mảng Keys
If Dic.count > 0 Then
Tmp = Dic.Keys
' tạo mảng Arr có số dòng bằng số chỉ số dòng được chọn và số cột bằng số côt của mảng nguồn sArray
ReDim Arr(LBound(TmpArr, 1) To UBound(Tmp) + LBound(TmpArr, 1) - HasTitle, LBound(TmpArr, 2) To UBound(TmpArr, 2))
' ghi các dòng của mảng nguồn mà có chỉ số là các phần tử cua Dic.Keys (tức các dòng được lấy) vào mảng Arr
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
' nếu mảng nguồn có chứa tiêu đề thì ghi tiêu đề vào mảng Arr ở dòng đầu tiên
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
' trả về mảng các dòng được chọn - lọc
Filter2DArray = Arr
End Function
