Hoàng Nhật Phương
Thành viên gắn bó
- Tham gia
- 5/11/15
- Bài viết
- 1,894
- Được thích
- 1,213
Hehe sau một hồi loay hoay OT làm theo gợi ý của anh Hai Lúa, dùng Recordset để lọc thì có thấy hơi khác một chút với Connection của bài Bạn @Hau151978 :
Recordset like sử dụng "*" còn Connection sử dụng "%"
Recordset không sử dụng where giống với Connection
Do đo OT cũng sửa lại chút hàm ConvertCriteria để tùy biến theo 2 phương pháp và kết hợp một thêm phần code của bác @HieuCD
OT cảm giác như dùng Recordset nhanh hơn Connection thì phải, toàn bộ code như sau , nhờ anh @Hai Lúa Miền Tây và mọi người góp ý ạ:
Mã:
Public Function ConvertCriteria(Field As String, Criteria As String, sLike As String) As String
If Criteria = "*" Then
ConvertCriteria = "TRUE"
Else
ConvertCriteria = "([" & Field & "] LIKE " & sLike & _
Replace(Criteria, ";", sLike & " OR [" & Field & "] LIKE " & sLike) & sLike & ")"
End If
End Function
Sub Filter_Rst()
Dim Rst As New ADODB.Recordset, sCn As String, SrtSQL As String
Dim wb As Workbook, shtFilter As Worksheet, sLike As String, Lr As Long
Dim Customer As String, Product As String, Profit As String, fDate As Date, eDate As Date
Const sDULIEU As String = "Select * from [Orders$]"
On Error GoTo ErrorProcess
Set wb = ThisWorkbook
Set shtFilter = wb.Worksheets("Filter")
With shtFilter
Lr = .Range("A" & Rows.Count).End(xlUp).Row
If Lr > 3 Then .Range("A4:J" & Lr).ClearContents
Customer = .Range("B1"): Product = .Range("B2")
fDate = .Range("D1"): eDate = .Range("D2")
Profit = .Range("E2")
End With
sLike = "*"
SrtSQL = ConvertCriteria("Customer Name", Customer, sLike)
SrtSQL = SrtSQL & " AND " & ConvertCriteria("Product category", Product, sLike)
If Not (IsDate(fDate) And IsDate(eDate)) Or fDate > eDate Then
MsgBox "Nhap lai dieu kien ngay thang", vbCritical, "Error"
GoTo EndSub
Else
If SrtSQL <> Empty Then
SrtSQL = SrtSQL & " AND ([Order date] >=#" & fDate & "#" & " AND [Order date] <=#" & eDate & "#)"
Else
SrtSQL = " ([Order date] >=#" & fDate & "#" & " And [Order date] <=#" & eDate & "#)"
End If
End If
If Profit <> Empty Then
If Profit = "=0" Then
SrtSQL = SrtSQL & " AND (Profit=0)"
Else
SrtSQL = SrtSQL & " AND Profit" & Profit
End If
End If
Debug.Print SrtSQL
sCn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & wb.FullName
With Rst
.Open sDULIEU, sCn, 1
.Filter = SrtSQL
shtFilter.Range("A4").CopyFromRecordset .DataSource
End With
GoTo EndSub
ErrorProcess:
If Err <> 0 Then
MsgBox Err.Number & "/" & Err.Source & "-->" & Err.Description, vbOKOnly + vbCritical, "Error"
End If
EndSub:
If Not Rst Is Nothing Then
If Rst.State = adStateOpen Then Rst.Close
End If
Set Rst = Nothing
End Sub
