filter2darray.bas

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