Chia sẻ code hàm FilterMCLArray dùng lọc mảng 2 chiều (7 người xem)

[Minh Tam 2024]

Nguồn ( trên mạng không nhớ tên )​

Hàm FilterMCLArray được dùng để lọc dữ liệu từ một mảng 2 chiều dựa trên một điều kiện cụ thể (FindStr). Nó có thể tìm kiếm giá trị chuỗi hoặc so sánh số.

• sArray: Mảng dữ liệu nguồn (có thể là mảng lấy từ một vùng trên Excel).
• TotalCol: Tổng số cột cần tìm kiếm.
• FindStr: Chuỗi hoặc điều kiện lọc (ví dụ: ">=100", "ABC").
• HasTitle: Xác định có dòng tiêu đề hay không (True/False).

Ví dụ minh họa​

Dữ liệu mẫu trong Excel​

Giả sử bạn có dữ liệu sau trong vùng A1:C6:

A (Mã)	B (Tên)	C (Doanh thu)
101	Nam	120
102	Linh	90
103	An	150
104	Bình	80
105	Hải	200

Bạn muốn lọc ra các dòng có doanh thu ≥ 100.

Sub TestFilter()
    Dim DataArr, ResultArr
    Dim LastRow As Long
    
    ' Xác định số dòng cuối cùng
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    ' Đọc dữ liệu từ vùng A1:C6 vào mảng
    DataArr = Range("A1:C" & LastRow).Value
    
    ' Gọi hàm để lọc doanh thu >= 100
    ResultArr = FilterMCLArray(DataArr, 3, ">=100", True)
    
    ' Xuất kết quả ra vùng E1:G1 (hoặc vị trí tùy chọn)
    If Not IsEmpty(ResultArr) Then
        Range("E1").Resize(UBound(ResultArr, 1), UBound(ResultArr, 2)).Value = ResultArr
    Else
        MsgBox "Không có dữ liệu phù hợp!", vbInformation
    End If
End Sub

Function FilterMCLArray(ByVal sArray, ByVal TotalCol As Long, ByVal FindStr As String, ByVal HasTitle As Boolean)
        
        Dim tmpArr, i As Long, j As Long, ColIndex As Long, k 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)
            
            For k = 1 To TotalCol
                
                ColIndex = k
                
                If Chk Then
                    
                    TmpVal = CDbl(tmpArr(i, ColIndex))
                    
                    If Evaluate(TmpVal & FindStr) Then Dic.Add i, ""
                    
                Else
                    
                    If InStr(UCase(tmpArr(i, ColIndex)), UCase(FindStr)) Then Dic.Add i, ""
                    
                End If
                
            Next
            
        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
        
        FilterMCLArray = Arr
        
    End Function