[COLOR=black]Sub MyFilter()
On Error Resume Next
Dim Rng As Range, CellCopy As Range, Cell01 As Range, CellTo As Range[/COLOR]
[COLOR=blue]'Kiểm tra vùng dữ liệu phải 1 cột[/COLOR][COLOR=black]
If Selection.Columns.Count > 1 Then
MsgBox "Ban chon vung du lieu 2 cot. Ket thuc", , "Advanced Filter"
Exit Sub
End If[/COLOR]
[COLOR=blue]'Nhập và kiểm tra cột phụ[/COLOR][COLOR=black]
Set CellCopy = Application.InputBox("Dung chuot chon o copy", "Advanced Filter", , , , , , 8)
If Err.Number > 0 Then
MsgBox "Ban khong chon o copy", , "Advanced Filter"
Exit Sub
ElseIf CellCopy.Count > 1 Then
MsgBox "Ban chon nhieu o copy. Ket thuc", , "Advanced Filter"
Exit Sub
ElseIf CellCopy.Column = Selection.Column Then
MsgBox "Ban chon trung cot du lieu. Ket thuc", , "Advanced Filter"
Exit Sub
End If[/COLOR]
[COLOR=blue]'Nhập và kiểm tra cột ghi advanced filter[/COLOR][COLOR=black]
Set CellTo = Application.InputBox("Dung chuot chon o Filter (cot Fiter se bi xoa du lieu)", "Advanced Filter", , , , , , 8)
If Err.Number > 0 Then
MsgBox "Ban khong chon o ghi Filter. Ket thuc", , "Advanced Filter"
Exit Sub
ElseIf CellTo.Count > 1 Then
MsgBox "Ban chon nhieu o, khong ghi Filter. Ket thuc", , "Advanced Filter"
Exit Sub
ElseIf CellCopy.Column = CellTo.Column Or CellTo.Column = Selection.Column Then
MsgBox "Ban chon trung cot du lieu hoac cot copy. Ket thuc", , "Advanced Filter"
Exit Sub
End If[/COLOR]
[COLOR=blue]'Copy sang cột phụ[/COLOR][COLOR=black]
Selection.Copy
CellCopy.Select
ActiveSheet.Paste
Set Rng = Selection
Set Cell01 = Rng.Item(1)[/COLOR]
[COLOR=blue]'Sort
[/COLOR][COLOR=black]Rng.Sort Key1:=Cell01, Order1:=xlAscending, Header:=xlNo[/COLOR]
[COLOR=black][/COLOR]
[COLOR=black][COLOR=blue]'Advanced Filter[/COLOR]
CellTo.EntireColumn.ClearContents
Rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=CellTo, Unique:=True[/COLOR]
[COLOR=blue]'Xóa dữ liệu tạm[/COLOR][COLOR=black]
Rng.ClearContents
CellTo.Select
End Sub
[/COLOR]
