https://www.hocexcel.online/userform-nhap-lieu-va-tra-cuu.html

Filter2DArray.bas

Function Filter2DArray(ByVal sArray, ByVal ColIndex As Long, ByVal FindStr As String, ByVal HasTitle As Boolean)
	
	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 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
	
	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