Hàm lọc 1 đến 2 cột, xuất ra các cột tùy ý (SimpleFilter dành cho mảng 2 chiều)

Liên hệ QC
Hoàng Trọng Nghĩa

Hoàng Trọng Nghĩa

Chuyên gia GPE
Thành viên BQT
Moderator
Tham gia
17/8/08
Bài viết
8,595
Được thích
16,655
Giới tính
Nam
Hàm lọc (Filter) thì có rất nhiều người viết trên diễn đàn (trong đó cũng có bài của tôi), tuy nhiên cũng dựa theo một vài điều cơ bản của các Thầy các Anh mà cải tiến cho hợp lý, thì bài này tôi viết ngắn gọn hơn, điểm mới là xuất ra các cột cần thực hiện chứ không phải giữ nguyên các cột ban đầu ở mảng đầu vào.

Giới thiệu sơ hàm SimpleFilter:

Cấu trúc:

SimpleFilter(Mảng ban đầu, Cột cần lọc 1, Dấu so sánh 1, Điều kiện 1, Dạng lọc 1, [Cột cần xuất], [Kiểu Và/Hoặc], [Cột cần lọc 2], [Dấu so sánh 2], [Điều kiện 2], [Dạng lọc 2])

Diễn giải:

1) Mảng ban đầu: Là mảng 2 chiều (bắt buộc)

2) Cột cần lọc: Số thứ tự cột nào đó chứa giá trị cần lọc (dạng số)

3) Dấu so sánh: là các dấu: "=", "<", ">", "<>", "<=", ">=" (dạng chuỗi nên để trong ngoặc kép)

4) Điều kiện: Là các điều kiện số/ ngày tháng, giờ/ chuỗi cần lọc (dạng chuỗi nên để trong ngoặc kép)

5) Dạng lọc: Dạng số ("n"), dạng chuỗi ("s"), dạng ngày tháng + thời gian ("d")

6) Cột cần xuất: Nếu không thể hiện ra thì mặc định là lấy hết các cột có trong mảng ban đầu, còn ghi ra thì cần để trong ngoặc kép, cách nhau bằng dấu phẩy (,), VD: "1,3,4,6"

7) Kiểu Và/Hoặc: Nếu kiểu Và bạn gõ (hoặc nó sẽ xổ ra) xlAnd, còn kiểu Hoặc bạn gõ xlOr.

8) Các mục trong cấu trúc có dấu [] là không bắt buộc phải nhập vào nếu chỉ lọc 1 điều kiện.

Thực hiện:

Lọc 1 điều kiện:

Arr = SimpleFilter(Range("a4:c33").Value, 2, "=", "*1", "s", "1,3,2,3")

Lưu ý: Ở đây điều kiện lọc là "*1", có nghĩa là dạng chuỗi, có dấu sao (*) là ký tự đại diện cho tất cả các ký tự phía trước (được hiểu là không quan tâm phía trước có gì), chỉ cần kết thúc chuỗi đó là 1. Tương tự với dấu "?" (thay thế 1 ký tự).

Lọc 2 điều kiện:

Arr = SimpleFilter(Range("a4:c33").Value, 3, ">", "23/04/2016 07:20", "d", "1,3,2", xlAnd, 2, "=", "*1*", "s")

Hàm SimpleFilter:

[GPECODE=vb]Option Explicit''**************************************************************************************
''Author: Hoang Trong Nghia - GiaiphapExcel.com
''Mobile: 0938.520.520 - 0929.38.77.38
''**************************************************************************************


Function SimpleFilter(ByVal sArray2D, _
ByVal lngField1 As Long, _
ByVal strCompareMark1 As String, _
ByVal strCriteria1 As String, _
ByVal strType1 As String, _
Optional ByVal strColumnsOutput As String, _
Optional ByVal xlOperator As XlAutoFilterOperator = xlAnd, _
Optional ByVal lngField2 As Long, _
Optional ByVal strCompareMark2 As String, _
Optional ByVal strCriteria2 As String, _
Optional ByVal strType2 As String)
''**************************************************************************************
''Voi strCompareMark : Neu strType la "d" hoac "n" thi cac dau so sanh nhu:
'' : "=", "<", ">", "<>", "<=", ">="
'' : Neu strType la "s", thi dau so sanh la: "=", "<>"
''Voi strType : "d" la dang Date (ngay thang)
'' : "n" la dang Number (dang so)
'' : "s" la dang String (dang chuoi)
''Voi strChooseColumns: So cot can loc, neu KHONG ghi gi het thi xem nhu ket qua
'' : lay tat ca cac cot tu mang nguon, con chon cac cot muon cho
'' : ra ket qua thi ghi ra, VD: "1,3,5" (cot 1, cot 3, cot 5)
''Voi xlOperator : Neu co 2 dieu kien thi chon xlAnd hoac xlOr (mac dinh xlAnd)
''**************************************************************************************
'On Error Resume Next
Dim Criteria1, Criteria2, GetRow()
Dim c As Long, n As Long, m As Long, r As Long
Dim lbd1 As Long, lbd2 As Long, ubd1 As Long, ubd2 As Long
lbd1 = LBound(sArray2D, 1): ubd1 = UBound(sArray2D, 1)

strType1 = LCase(Replace(strType1, " ", ""))
strCompareMark1 = Replace(strCompareMark1, " ", "")
If strCompareMark1 = "" Then strCompareMark1 = "="
If strType1 = "s" Then
Criteria1 = LCase(strCriteria1)
Else
If strType1 = "d" Then
Criteria1 = CDbl(CDate(strCriteria1))
Else
Criteria1 = CDbl(strCriteria1)
End If
End If
If strCriteria2 <> "" Then
strType2 = LCase(Replace(strType2, " ", ""))
strCompareMark2 = Replace(strCompareMark2, " ", "")
If strCompareMark2 = "" Then strCompareMark2 = "="
If strType2 = "s" Then
Criteria2 = LCase(strCriteria2)
Else
If strType2 = "d" Then
Criteria2 = CDbl(CDate(strCriteria2))
Else
Criteria2 = CDbl(strCriteria2)
End If
End If
End If
If strCriteria2 = "" Then
Select Case strType1
Case "d", "n"
For r = lbd1 To ubd1
If Evaluate(CDbl(sArray2D(r, lngField1)) & strCompareMark1 & Criteria1) Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
Case Else
If strCompareMark1 = "<>" Then
For r = lbd1 To ubd1
If Not LCase(sArray2D(r, lngField1)) Like Criteria1 Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
Else
For r = lbd1 To ubd1
If LCase(sArray2D(r, lngField1)) Like Criteria1 Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
End If
End Select
Else
If strType1 <> "s" And strType2 <> "s" Then ''Tat ca dang date/number
If xlOperator = xlAnd Then
For r = lbd1 To ubd1
If Evaluate(CDbl(sArray2D(r, lngField1)) & strCompareMark1 & Criteria1) _
And Evaluate(CDbl(sArray2D(r, lngField2)) & strCompareMark2 & Criteria2) Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
Else
For r = lbd1 To ubd1
If Evaluate(CDbl(sArray2D(r, lngField1)) & strCompareMark1 & Criteria1) _
Or Evaluate(CDbl(sArray2D(r, lngField2)) & strCompareMark2 & Criteria2) Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
End If
ElseIf strType1 = "s" And strType2 = "s" Then ''Tat ca dang string
If strCompareMark1 = "<>" And strCompareMark2 = "<>" Then
If xlOperator = xlAnd Then
For r = lbd1 To ubd1
If Not LCase(sArray2D(r, lngField1)) Like Criteria1 _
And Not LCase(sArray2D(r, lngField2)) Like Criteria2 Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
Else
For r = lbd1 To ubd1
If Not LCase(sArray2D(r, lngField1)) Like Criteria1 _
Or Not LCase(sArray2D(r, lngField2)) Like Criteria2 Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
End If
ElseIf strCompareMark1 = "=" And strCompareMark2 = "=" Then
If xlOperator = xlAnd Then
For r = lbd1 To ubd1
If LCase(sArray2D(r, lngField1)) Like Criteria1 _
And LCase(sArray2D(r, lngField2)) Like Criteria2 Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
Else
For r = lbd1 To ubd1
If LCase(sArray2D(r, lngField1)) Like Criteria1 _
Or LCase(sArray2D(r, lngField2)) Like Criteria2 Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
End If
ElseIf strCompareMark1 = "<>" And strCompareMark2 = "=" Then
If xlOperator = xlAnd Then
For r = lbd1 To ubd1
If Not LCase(sArray2D(r, lngField1)) Like Criteria1 _
And LCase(sArray2D(r, lngField2)) Like Criteria2 Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
Else
For r = lbd1 To ubd1
If Not LCase(sArray2D(r, lngField1)) Like Criteria1 _
Or LCase(sArray2D(r, lngField2)) Like Criteria2 Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
End If
Else
If xlOperator = xlAnd Then
For r = lbd1 To ubd1
If LCase(sArray2D(r, lngField1)) Like Criteria1 _
And Not LCase(sArray2D(r, lngField2)) Like Criteria2 Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
Else
For r = lbd1 To ubd1
If LCase(sArray2D(r, lngField1)) Like Criteria1 _
Or Not LCase(sArray2D(r, lngField2)) Like Criteria2 Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
End If
End If
ElseIf strType1 = "s" And strType2 <> "s" Then ''Dang string va dang date/number
If strCompareMark1 = "<>" Then
If xlOperator = xlAnd Then
For r = lbd1 To ubd1
If Not LCase(sArray2D(r, lngField1)) Like Criteria1 _
And Evaluate(CDbl(sArray2D(r, lngField2)) & strCompareMark2 & Criteria2) Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
Else
For r = lbd1 To ubd1
If Not LCase(sArray2D(r, lngField1)) Like Criteria1 _
Or Evaluate(CDbl(sArray2D(r, lngField2)) & strCompareMark2 & Criteria2) Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
End If
Else
If xlOperator = xlAnd Then
For r = lbd1 To ubd1
If LCase(sArray2D(r, lngField1)) Like Criteria1 _
And Evaluate(CDbl(sArray2D(r, lngField2)) & strCompareMark2 & Criteria2) Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
Else
For r = lbd1 To ubd1
If LCase(sArray2D(r, lngField1)) Like Criteria1 _
Or Evaluate(CDbl(sArray2D(r, lngField2)) & strCompareMark2 & Criteria2) Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
End If
End If
Else ''Dang date/number va string
If strCompareMark2 = "<>" Then
If xlOperator = xlAnd Then
For r = lbd1 To ubd1
If Not LCase(sArray2D(r, lngField2)) Like Criteria2 _
And Evaluate(CDbl(sArray2D(r, lngField1)) & strCompareMark1 & Criteria1) Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
Else
For r = lbd1 To ubd1
If Not LCase(sArray2D(r, lngField2)) Like Criteria2 _
Or Evaluate(CDbl(sArray2D(r, lngField1)) & strCompareMark1 & Criteria1) Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
End If
Else
If xlOperator = xlAnd Then
For r = lbd1 To ubd1
If LCase(sArray2D(r, lngField2)) Like Criteria2 _
And Evaluate(CDbl(sArray2D(r, lngField1)) & strCompareMark1 & Criteria1) Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
Else
For r = lbd1 To ubd1
If LCase(sArray2D(r, lngField2)) Like Criteria2 _
Or Evaluate(CDbl(sArray2D(r, lngField1)) & strCompareMark1 & Criteria1) Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
End If
End If
End If
End If
If n Then
Dim ArrCol
strColumnsOutput = Replace(strColumnsOutput, " ", "")
If strColumnsOutput = "" Then
lbd2 = LBound(sArray2D, 2): ubd2 = UBound(sArray2D, 2)
ReDim ArrCol(1)
For c = lbd2 To ubd2
m = m + 1
ReDim Preserve ArrCol(1 To m)
ArrCol(m) = c
Next
Else
ArrCol = Split("0," & strColumnsOutput, ",")
End If
ubd2 = UBound(ArrCol)
ReDim ArrFilter(1 To n, 1 To ubd2)
For r = 1 To n
For c = 1 To ubd2
ArrFilter(r, c) = sArray2D(GetRow(r), ArrCol(c))
Next
Next
SimpleFilter = ArrFilter
Else
Dim ArrTmp(1 To 1, 1 To 1)
SimpleFilter = ArrTmp
End If
End Function
[/GPECODE]

P/s: Hàm chưa có điều kiện test kỹ, nên các bạn cứ tự tạo dữ liệu và tự lọc các điều kiện ngẫu nhiên, bất kỳ, nếu có xảy ra lỗi gì vui lòng cảnh báo cho tôi. Cám ơn.
 

File đính kèm

  • SimpleFilter.xlsm
    31.4 KB · Đọc: 104
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Chưa biết cách sử dụng ra sao?
 
Upvote 0
Hàm rất hữu ích. Đúng yêu cầu mình cần, thank!-=.,,
 
Upvote 0
anh Hoàng Trọng Nghĩa ơi cái hàm lọc của anh ấn nút test có hiện tượng gì đâu ạ
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Trong File có Macro Test trong Module mdlTest để chạy thử đó anh, anh lần lượt anh bỏ dấu nháy cho chạy từng Arr một thì sẽ có kết quả trên sheet thôi.
Nhấp chuột vào đây để mở rộng...
anh nghĩa đẹp zai ơi em bỏ nút ' đi nhưng test code của anh không thấy chạy ạ, em mới vào diễn đàn nên chưa biết mấy mong anh chị trong diễn đàn hỗ trợ ạ
 
Upvote 0
Tuanba1992 đã viết:
anh nghĩa đẹp zai ơi em bỏ nút ' đi nhưng test code của anh không thấy chạy ạ, em mới vào diễn đàn nên chưa biết mấy mong anh chị trong diễn đàn hỗ trợ ạ
Nhấp chuột vào đây để mở rộng...
Bạn Enable Macro chưa? Nếu không thì code không thể thực hiện được đâu.
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Hàm lọc (Filter) thì có rất nhiều người viết trên diễn đàn (trong đó cũng có bài của tôi), tuy nhiên cũng dựa theo một vài điều cơ bản của các Thầy các Anh mà cải tiến cho hợp lý, thì bài này tôi viết ngắn gọn hơn, điểm mới là xuất ra các cột cần thực hiện chứ không phải giữ nguyên các cột ban đầu ở mảng đầu vào.

Giới thiệu sơ hàm SimpleFilter:

Cấu trúc:

SimpleFilter(Mảng ban đầu, Cột cần lọc 1, Dấu so sánh 1, Điều kiện 1, Dạng lọc 1, [Cột cần xuất], [Kiểu Và/Hoặc], [Cột cần lọc 2], [Dấu so sánh 2], [Điều kiện 2], [Dạng lọc 2])

Diễn giải:

1) Mảng ban đầu: Là mảng 2 chiều (bắt buộc)

2) Cột cần lọc: Số thứ tự cột nào đó chứa giá trị cần lọc (dạng số)

3) Dấu so sánh: là các dấu: "=", "<", ">", "<>", "<=", ">=" (dạng chuỗi nên để trong ngoặc kép)

4) Điều kiện: Là các điều kiện số/ ngày tháng, giờ/ chuỗi cần lọc (dạng chuỗi nên để trong ngoặc kép)

5) Dạng lọc: Dạng số ("n"), dạng chuỗi ("s"), dạng ngày tháng + thời gian ("d")

6) Cột cần xuất: Nếu không thể hiện ra thì mặc định là lấy hết các cột có trong mảng ban đầu, còn ghi ra thì cần để trong ngoặc kép, cách nhau bằng dấu phẩy (,), VD: "1,3,4,6"

7) Kiểu Và/Hoặc: Nếu kiểu Và bạn gõ (hoặc nó sẽ xổ ra) xlAnd, còn kiểu Hoặc bạn gõ xlOr.

8) Các mục trong cấu trúc có dấu [] là không bắt buộc phải nhập vào nếu chỉ lọc 1 điều kiện.

Thực hiện:

Lọc 1 điều kiện:

Arr = SimpleFilter(Range("a4:c33").Value, 2, "=", "*1", "s", "1,3,2,3")

Lưu ý: Ở đây điều kiện lọc là "*1", có nghĩa là dạng chuỗi, có dấu sao (*) là ký tự đại diện cho tất cả các ký tự phía trước (được hiểu là không quan tâm phía trước có gì), chỉ cần kết thúc chuỗi đó là 1. Tương tự với dấu "?" (thay thế 1 ký tự).

Lọc 2 điều kiện:

Arr = SimpleFilter(Range("a4:c33").Value, 3, ">", "23/04/2016 07:20", "d", "1,3,2", xlAnd, 2, "=", "*1*", "s")

Hàm SimpleFilter:

[GPECODE=vb]Option Explicit''**************************************************************************************
''Author: Hoang Trong Nghia - GiaiphapExcel.com
''Mobile: 0938.520.520 - 0929.38.77.38
''**************************************************************************************


Function SimpleFilter(ByVal sArray2D, _
ByVal lngField1 As Long, _
ByVal strCompareMark1 As String, _
ByVal strCriteria1 As String, _
ByVal strType1 As String, _
Optional ByVal strColumnsOutput As String, _
Optional ByVal xlOperator As XlAutoFilterOperator = xlAnd, _
Optional ByVal lngField2 As Long, _
Optional ByVal strCompareMark2 As String, _
Optional ByVal strCriteria2 As String, _
Optional ByVal strType2 As String)
''**************************************************************************************
''Voi strCompareMark : Neu strType la "d" hoac "n" thi cac dau so sanh nhu:
'' : "=", "<", ">", "<>", "<=", ">="
'' : Neu strType la "s", thi dau so sanh la: "=", "<>"
''Voi strType : "d" la dang Date (ngay thang)
'' : "n" la dang Number (dang so)
'' : "s" la dang String (dang chuoi)
''Voi strChooseColumns: So cot can loc, neu KHONG ghi gi het thi xem nhu ket qua
'' : lay tat ca cac cot tu mang nguon, con chon cac cot muon cho
'' : ra ket qua thi ghi ra, VD: "1,3,5" (cot 1, cot 3, cot 5)
''Voi xlOperator : Neu co 2 dieu kien thi chon xlAnd hoac xlOr (mac dinh xlAnd)
''**************************************************************************************
'On Error Resume Next
Dim Criteria1, Criteria2, GetRow()
Dim c As Long, n As Long, m As Long, r As Long
Dim lbd1 As Long, lbd2 As Long, ubd1 As Long, ubd2 As Long
lbd1 = LBound(sArray2D, 1): ubd1 = UBound(sArray2D, 1)

strType1 = LCase(Replace(strType1, " ", ""))
strCompareMark1 = Replace(strCompareMark1, " ", "")
If strCompareMark1 = "" Then strCompareMark1 = "="
If strType1 = "s" Then
Criteria1 = LCase(strCriteria1)
Else
If strType1 = "d" Then
Criteria1 = CDbl(CDate(strCriteria1))
Else
Criteria1 = CDbl(strCriteria1)
End If
End If
If strCriteria2 <> "" Then
strType2 = LCase(Replace(strType2, " ", ""))
strCompareMark2 = Replace(strCompareMark2, " ", "")
If strCompareMark2 = "" Then strCompareMark2 = "="
If strType2 = "s" Then
Criteria2 = LCase(strCriteria2)
Else
If strType2 = "d" Then
Criteria2 = CDbl(CDate(strCriteria2))
Else
Criteria2 = CDbl(strCriteria2)
End If
End If
End If
If strCriteria2 = "" Then
Select Case strType1
Case "d", "n"
For r = lbd1 To ubd1
If Evaluate(CDbl(sArray2D(r, lngField1)) & strCompareMark1 & Criteria1) Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
Case Else
If strCompareMark1 = "<>" Then
For r = lbd1 To ubd1
If Not LCase(sArray2D(r, lngField1)) Like Criteria1 Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
Else
For r = lbd1 To ubd1
If LCase(sArray2D(r, lngField1)) Like Criteria1 Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
End If
End Select
Else
If strType1 <> "s" And strType2 <> "s" Then ''Tat ca dang date/number
If xlOperator = xlAnd Then
For r = lbd1 To ubd1
If Evaluate(CDbl(sArray2D(r, lngField1)) & strCompareMark1 & Criteria1) _
And Evaluate(CDbl(sArray2D(r, lngField2)) & strCompareMark2 & Criteria2) Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
Else
For r = lbd1 To ubd1
If Evaluate(CDbl(sArray2D(r, lngField1)) & strCompareMark1 & Criteria1) _
Or Evaluate(CDbl(sArray2D(r, lngField2)) & strCompareMark2 & Criteria2) Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
End If
ElseIf strType1 = "s" And strType2 = "s" Then ''Tat ca dang string
If strCompareMark1 = "<>" And strCompareMark2 = "<>" Then
If xlOperator = xlAnd Then
For r = lbd1 To ubd1
If Not LCase(sArray2D(r, lngField1)) Like Criteria1 _
And Not LCase(sArray2D(r, lngField2)) Like Criteria2 Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
Else
For r = lbd1 To ubd1
If Not LCase(sArray2D(r, lngField1)) Like Criteria1 _
Or Not LCase(sArray2D(r, lngField2)) Like Criteria2 Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
End If
ElseIf strCompareMark1 = "=" And strCompareMark2 = "=" Then
If xlOperator = xlAnd Then
For r = lbd1 To ubd1
If LCase(sArray2D(r, lngField1)) Like Criteria1 _
And LCase(sArray2D(r, lngField2)) Like Criteria2 Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
Else
For r = lbd1 To ubd1
If LCase(sArray2D(r, lngField1)) Like Criteria1 _
Or LCase(sArray2D(r, lngField2)) Like Criteria2 Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
End If
ElseIf strCompareMark1 = "<>" And strCompareMark2 = "=" Then
If xlOperator = xlAnd Then
For r = lbd1 To ubd1
If Not LCase(sArray2D(r, lngField1)) Like Criteria1 _
And LCase(sArray2D(r, lngField2)) Like Criteria2 Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
Else
For r = lbd1 To ubd1
If Not LCase(sArray2D(r, lngField1)) Like Criteria1 _
Or LCase(sArray2D(r, lngField2)) Like Criteria2 Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
End If
Else
If xlOperator = xlAnd Then
For r = lbd1 To ubd1
If LCase(sArray2D(r, lngField1)) Like Criteria1 _
And Not LCase(sArray2D(r, lngField2)) Like Criteria2 Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
Else
For r = lbd1 To ubd1
If LCase(sArray2D(r, lngField1)) Like Criteria1 _
Or Not LCase(sArray2D(r, lngField2)) Like Criteria2 Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
End If
End If
ElseIf strType1 = "s" And strType2 <> "s" Then ''Dang string va dang date/number
If strCompareMark1 = "<>" Then
If xlOperator = xlAnd Then
For r = lbd1 To ubd1
If Not LCase(sArray2D(r, lngField1)) Like Criteria1 _
And Evaluate(CDbl(sArray2D(r, lngField2)) & strCompareMark2 & Criteria2) Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
Else
For r = lbd1 To ubd1
If Not LCase(sArray2D(r, lngField1)) Like Criteria1 _
Or Evaluate(CDbl(sArray2D(r, lngField2)) & strCompareMark2 & Criteria2) Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
End If
Else
If xlOperator = xlAnd Then
For r = lbd1 To ubd1
If LCase(sArray2D(r, lngField1)) Like Criteria1 _
And Evaluate(CDbl(sArray2D(r, lngField2)) & strCompareMark2 & Criteria2) Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
Else
For r = lbd1 To ubd1
If LCase(sArray2D(r, lngField1)) Like Criteria1 _
Or Evaluate(CDbl(sArray2D(r, lngField2)) & strCompareMark2 & Criteria2) Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
End If
End If
Else ''Dang date/number va string
If strCompareMark2 = "<>" Then
If xlOperator = xlAnd Then
For r = lbd1 To ubd1
If Not LCase(sArray2D(r, lngField2)) Like Criteria2 _
And Evaluate(CDbl(sArray2D(r, lngField1)) & strCompareMark1 & Criteria1) Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
Else
For r = lbd1 To ubd1
If Not LCase(sArray2D(r, lngField2)) Like Criteria2 _
Or Evaluate(CDbl(sArray2D(r, lngField1)) & strCompareMark1 & Criteria1) Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
End If
Else
If xlOperator = xlAnd Then
For r = lbd1 To ubd1
If LCase(sArray2D(r, lngField2)) Like Criteria2 _
And Evaluate(CDbl(sArray2D(r, lngField1)) & strCompareMark1 & Criteria1) Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
Else
For r = lbd1 To ubd1
If LCase(sArray2D(r, lngField2)) Like Criteria2 _
Or Evaluate(CDbl(sArray2D(r, lngField1)) & strCompareMark1 & Criteria1) Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
End If
End If
End If
End If
If n Then
Dim ArrCol
strColumnsOutput = Replace(strColumnsOutput, " ", "")
If strColumnsOutput = "" Then
lbd2 = LBound(sArray2D, 2): ubd2 = UBound(sArray2D, 2)
ReDim ArrCol(1)
For c = lbd2 To ubd2
m = m + 1
ReDim Preserve ArrCol(1 To m)
ArrCol(m) = c
Next
Else
ArrCol = Split("0," & strColumnsOutput, ",")
End If
ubd2 = UBound(ArrCol)
ReDim ArrFilter(1 To n, 1 To ubd2)
For r = 1 To n
For c = 1 To ubd2
ArrFilter(r, c) = sArray2D(GetRow(r), ArrCol(c))
Next
Next
SimpleFilter = ArrFilter
Else
Dim ArrTmp(1 To 1, 1 To 1)
SimpleFilter = ArrTmp
End If
End Function
[/GPECODE]

P/s: Hàm chưa có điều kiện test kỹ, nên các bạn cứ tự tạo dữ liệu và tự lọc các điều kiện ngẫu nhiên, bất kỳ, nếu có xảy ra lỗi gì vui lòng cảnh báo cho tôi. Cám ơn.
Nhấp chuột vào đây để mở rộng...
Anh cho em hỏi với, đối với hàm này có thể dùng để tạo sổ cái tài khoản trong kế toán dạng ( Function) để làm không ạ! Em cảm ơn anh ạ
 

File đính kèm

  • FindGPE06-TaoSoQuy-SoCai.rar
    61.6 KB · Đọc: 14
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

M
Bảng Pivot ko tự update theo dữ liệu và còn cộng thiếu số liệu.
Trả lời
4
Đọc
20
Hoàng Trọng Nghĩa
Hoàng Trọng Nghĩa
hung2412
  • Question
Có Code VBA nào để chỉnh Short date trong Control Panel không? (Ví dụ: Chỉnh dd/mm/yy => dd/mm/yyyy)
Trả lời
4
Đọc
73
hoangtuan.net
hoangtuan.net
H
Nhờ mấy anh chị giúp về công thức dò tìm kiếm và trả về kết quả ngày tháng
Trả lời
5
Đọc
64
DeTong
D
S
  • Question
Không lấy đủ dữ liệu bằng kết nối ADO
Trả lời
6
Đọc
169
Hoàng Trọng Nghĩa
Hoàng Trọng Nghĩa
A
Đếm dữ liệu với điều kiện
Trả lời
13
Đọc
174
Duy Tùng 9x
Duy Tùng 9x
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom