Yêu cầu tự động lọc của bạn ghi trong file là không thể làm được với tất cả bởi code không thể biết đến điều kiện nào thì dừng. Do vậy phải có nút bấm để chạy sau khi đã nhập xong tất cả các điều kiện.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr&, i&, rng, tmp(), bd As Double, kt As Double, mh, nv
Application.ScreenUpdating = False
If Intersect(Target, Range("D3,D4,F3,F4")) Is Nothing Then Exit Sub
Range("A7:A100000").EntireRow.Hidden = False
bd = Range("D3").Value2: kt = Range("D4").Value2
mh = Range("F3").Value: nv = Range("F4").Value
lr = Cells(Rows.Count, "B").End(xlUp).Row
rng = Range("A7:D" & lr).Value2
ReDim tmp(1 To UBound(rng), 1 To 1)
For i = 1 To UBound(rng)
If rng(i, 2) >= bd And rng(i, 2) <= IIf(kt = 0, 100 ^ 100, kt) And _
rng(i, 3) = IIf(mh = "", rng(i, 3), mh) And UCase(rng(i, 4)) Like IIf(nv = "", "*", "*" & UCase(nv) & "*") Then
tmp(i, 1) = rng(i, 1)
Else: tmp(i, 1) = ""
End If
Next
With Range("XX7")
.Resize(10000, 1).ClearContents
.Resize(UBound(rng), 1).Value = tmp
On Error Resume Next
.Resize(UBound(rng), 1).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
.Resize(10000, 1).ClearContents
End With
Application.ScreenUpdating = True
End SubCảm ơn bạn rất nhiều! code chạy nhanh mượt lắm.
Không viết hoa toàn bộ tiêu đề nhé bạn, một cách làm khác bạn tham khảo:
Option Explicit
Sub FilterData()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strSQL As String
Dim startDate As Date, endDate As Date
Dim LastRow As Long
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 12.0 Macro;HDR=YES"";"
LastRow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
If LastRow < 7 Then GoTo End_
startDate = Sheet1.Range("D3")
endDate = Sheet1.Range("D4")
If startDate = 0 Or endDate = 0 Or endDate < startDate Then GoTo End_
strSQL = "SELECT * FROM [Sheet1$A6:F" & LastRow & "] " & _
"WHERE [NGAY_THANG] BETWEEN #" & startDate & "# AND #" & endDate & "#" & _
" AND [MAT_HANG] Like '%" & Sheet1.Range("F3") & "%'" & _
" AND [NHAN_VIEN] Like '%" & Sheet1.Range("F4") & "%'"
rs.Open strSQL, cn
Sheet1.Range("I7").Resize(10000, 6).ClearContents
Sheet1.Range("I7").CopyFromRecordset rs
End_:
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End SubLâu rồi mới thấy chị OT xuất hiện !
