Sub autoFilt()
' Dung gia tri cua su chon hien thoi lam dieu kien loc tu dong
' co the chon 1 hoac 2 o, voi 2 o: neu khac cot thi loc theo nghia "and", cu`ng cot thi theo nghia "or"
' co the chon gia tri ben trong vu`ng loc hoac ngay tren, ngay duoi (voi khoang cach toi da la 5 do`ng, toi thieu 1 do`ng)
Dim s As Worksheet
Dim r As Range
Dim c As Range, c1 As Range, c2 As Range
Dim cri As Variant, cri1 As Variant, cri2 As Variant, fie1, fie2
Set s = ActiveSheet
Set c = Application.Selection 'ActiveCell
Set c1 = c.Cells(1, 1)
Set c2 = c1
cri1 = [c1]
cri2 = cri1
If c.Areas.Count = 1 Then
If c.Rows.Count > 1 Then
Set c2 = c.Cells(2, 1)
cri2 = [c2]
ElseIf c.Columns.Count > 1 Then
Set c2 = c.Cells(1, 2)
cri2 = [c2]
Else
cri2 = ""
End If
ElseIf c.Areas.Count > 1 Then
Set c2 = c.Areas(2).Cells(1, 1)
cri2 = [c2]
End If
s.AutoFilterMode = False
On Error Resume Next
Set r = s.Range(s.Name)
' Neu tren Sheet da co mot vung dat trung ten voi ten sheet thi dung vung nay,
' neu chua co, thi se tu dong tim.
If Err.Number <> 0 Then Set r = c.CurrentRegion ' Gia tri loc nam trong vung can loc
If r.Cells.Count < 3 Then '.Rows.Count = 1 Then ' Gia tri loc nam ngoai vung can loc
If Len(r.Offset(5, 0).Cells(1, 1)) < 1 Then
Set r = r.Offset(-5, 0).CurrentRegion ' dich xuong 5 dong de xac dinh vung can loc
Else
Set r = r.Offset(5, 0).CurrentRegion ' dich len 5 dong de xac dinh vung can loc
End If
End If
If cri1 = "" Then
r.AutoFilter
Else
fie1 = c1.Column + 1 - r.Column ' tinh toan vi tri cua cot se loc
fie2 = c2.Column + 1 - r.Column ' tinh toan vi tri cua cot se loc
' neu gia tri la so hoac bieu thuc so sanh thi khong noi them dau *
If ((Not IsNumeric(cri1)) And (Left(cri1, 1) Like "[!<>=?]")) Then cri1 = cri1 & "*"
If ((Not IsNumeric(cri2)) And (Left(cri2, 1) Like "[!<>=?]")) Then cri2 = cri2 & "*"
If c1.Column = c2.Column Then
r.AutoFilter Field:=fie1, Criteria1:=cri1, Operator:=xlOr, Criteria2:=cri2
Else
r.AutoFilter Field:=fie1, Criteria1:=cri1
r.AutoFilter Field:=fie2, Criteria1:=cri2
End If
End If
Set s = Nothing
Set r = Nothing
Set c = Nothing
Set c1 = Nothing
Set c2 = Nothing
End Sub
