(EXCEL) Macro bỏ bộ lọc trên tất cả sheet đang hiển thị và có thể quay lại

byCÁ CẢNH QUỐC AN •
0

 

Macro bỏ toàn bộ bộ lọc ở các sheet đang hiển thị trong Excel

Khi làm việc với nhiều sheet trong Excel, đặc biệt là các file có bật bảo vệ sheet bằng macro, đôi khi bạn cần xóa toàn bộ điều kiện lọc trên các sheet đang hiển thị nhưng vẫn muốn:

  • mật khẩu 09xxx;
  • chỉ xử lý sheet đang hiển thị;
  • sheet ẩn/VeryHidden không đụng tới;
  • sheet đang khóa → mở tạm → xử lý → khóa lại;
  • sheet mật khẩu khác → bỏ qua;
  • 1 macro duy nhất để gán 1 phím/nút;
  • bấm lần 1: lưu bộ lọc hiện tại + bỏ lọc;
  • bấm lần 2: khôi phục bộ lọc cũ;
  • giữ nguyên nút Filter;
  • giữ quyền Filter và PivotTable sau khi khóa lại.

Dưới đây là macro phù hợp với trường hợp đó.

1. Macro bỏ toàn bộ bộ lọc ở các sheet đang hiển thị, bấm lần 2 thì quay lại đúng như thế

Option Explicit

Private gLocDaLuu As Object
Private gChoKhoiPhuc As Boolean
Private gTenWorkbook As String


'====================================================
' MACRO DUY NHAT DE GAN PHIM / NUT BAM
'
' LAN 1 = LUU LOC + HIEN TAT CA
' LAN 2 = KHOI PHUC LOC CU
'====================================================
Public Sub BoLoc_1PhimBam()

    Dim wb As Workbook

    If ActiveWorkbook Is Nothing Then Exit Sub

    Set wb = ActiveWorkbook

    If UCase$(wb.Name) = "PERSONAL.XLSB" Then

        MsgBox "Hay chon file Excel can xu ly.", _
               vbExclamation, "BO LOC"

        Exit Sub

    End If


    If gChoKhoiPhuc = False Then

        LuuVaBoLoc wb

    Else

        If gTenWorkbook <> wb.FullName Then

            MsgBox _
                "Trang thai loc dang duoc luu cho file:" & vbCrLf & _
                gTenWorkbook & vbCrLf & vbCrLf & _
                "Hay quay lai dung file do.", _
                vbExclamation, "BO LOC"

            Exit Sub

        End If

        KhoiPhucLoc wb

    End If

End Sub


'====================================================
' LAN 1
' MO KHOA TAT CA -> LUU LOC -> BO LOC -> KHOA LAI
'====================================================
Private Sub LuuVaBoLoc(ByVal wb As Workbook)

    Dim ws As Worksheet
    Dim MatKhau As String

    Dim TrangThaiKhoa As Object
    Dim DicSheet As Object
    Dim DicField As Object
    Dim DicLoc As Object

    Dim f As Filter

    Dim i As Long
    Dim SoSheetLoc As Long
    Dim SoSheetBoQua As Long

    Dim C1 As Variant
    Dim C2 As Variant
    Dim Op As Long
    Dim CoC2 As Boolean

    MatKhau = "0943836131"

    Set gLocDaLuu = CreateObject("Scripting.Dictionary")
    Set TrangThaiKhoa = CreateObject("Scripting.Dictionary")

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    On Error GoTo XuLyLoi


    '================================================
    ' 1. MO KHOA TAT CA SHEET DANG HIEN
    '================================================
    For Each ws In wb.Worksheets

        If ws.Visible = xlSheetVisible Then

            TrangThaiKhoa(ws.Name) = ws.ProtectContents

            If ws.ProtectContents Then

                On Error Resume Next
                Err.Clear

                ws.Unprotect Password:=MatKhau

                If Err.Number <> 0 Or ws.ProtectContents Then

                    TrangThaiKhoa(ws.Name) = "BOQUA"
                    SoSheetBoQua = SoSheetBoQua + 1

                End If

                Err.Clear
                On Error GoTo XuLyLoi

            End If

        End If

    Next ws


    '================================================
    ' 2. CHI XU LY CAC SHEET DA MO KHOA
    '================================================
    For Each ws In wb.Worksheets

        If ws.Visible = xlSheetVisible Then

            If TrangThaiKhoa.Exists(ws.Name) Then

                If TrangThaiKhoa(ws.Name) <> "BOQUA" Then

                    'Phai chac chan sheet khong con bao ve
                    If ws.ProtectContents = False Then

                        '--------------------------------
                        ' LUU BO LOC
                        '--------------------------------
                        If ws.AutoFilterMode Then

                            If Not ws.AutoFilter Is Nothing Then

                                Set DicSheet = _
                                    CreateObject("Scripting.Dictionary")

                                Set DicField = _
                                    CreateObject("Scripting.Dictionary")

                                DicSheet.Add _
                                    "Range", _
                                    ws.AutoFilter.Range.Address

                                For i = 1 To ws.AutoFilter.Filters.Count

                                    Set f = ws.AutoFilter.Filters(i)

                                    If f.On Then

                                        C1 = Empty
                                        C2 = Empty
                                        Op = 0
                                        CoC2 = False

                                        On Error Resume Next

                                        Err.Clear
                                        C1 = f.Criteria1

                                        Err.Clear
                                        Op = f.Operator

                                        Err.Clear
                                        C2 = f.Criteria2

                                        If Err.Number = 0 Then
                                            CoC2 = True
                                        End If

                                        Err.Clear
                                        On Error GoTo XuLyLoi


                                        Set DicLoc = _
                                            CreateObject("Scripting.Dictionary")

                                        DicLoc.Add "C1", C1
                                        DicLoc.Add "OP", Op
                                        DicLoc.Add "CoC2", CoC2

                                        If CoC2 Then
                                            DicLoc.Add "C2", C2
                                        End If

                                        DicField.Add _
                                            CStr(i), DicLoc

                                    End If

                                Next i


                                If DicField.Count > 0 Then

                                    DicSheet.Add _
                                        "Fields", DicField

                                    gLocDaLuu.Add _
                                        ws.Name, DicSheet

                                    SoSheetLoc = SoSheetLoc + 1

                                End If

                            End If

                        End If


                        '--------------------------------
                        ' BO DIEU KIEN LOC
                        ' GIU NGUYEN NUT FILTER
                        '--------------------------------
                        If ws.FilterMode Then
                            ws.ShowAllData
                        End If

                    End If

                End If

            End If

        End If

    Next ws


    '================================================
    ' 3. KHOA LAI CAC SHEET BAN DAU DANG KHOA
    '================================================
    For Each ws In wb.Worksheets

        If TrangThaiKhoa.Exists(ws.Name) Then

            If TrangThaiKhoa(ws.Name) <> "BOQUA" Then

                If TrangThaiKhoa(ws.Name) = True Then

                    KhoaSheet ws, MatKhau

                End If

            End If

        End If

    Next ws


    Application.EnableEvents = True
    Application.ScreenUpdating = True


    If gLocDaLuu.Count = 0 Then

        Set gLocDaLuu = Nothing

        gChoKhoiPhuc = False
        gTenWorkbook = ""

        MsgBox _
            "Khong co dieu kien loc nao dang duoc ap dung.", _
            vbInformation, "BO LOC"

    Else

        gChoKhoiPhuc = True
        gTenWorkbook = wb.FullName

        MsgBox _
            "DA LUU VA BO DIEU KIEN LOC." & vbCrLf & vbCrLf & _
            "Sheet co loc: " & SoSheetLoc & vbCrLf & _
            "Sheet bo qua: " & SoSheetBoQua & vbCrLf & vbCrLf & _
            "Bam lai cung phim de khoi phuc.", _
            vbInformation, "BO LOC"

    End If

    Exit Sub


XuLyLoi:

    On Error Resume Next

    'Co gang khoa lai dung trang thai ban dau
    For Each ws In wb.Worksheets

        If TrangThaiKhoa.Exists(ws.Name) Then

            If TrangThaiKhoa(ws.Name) = True Then

                If ws.ProtectContents = False Then
                    KhoaSheet ws, MatKhau
                End If

            End If

        End If

    Next ws

    Application.EnableEvents = True
    Application.ScreenUpdating = True

    MsgBox _
        "Co loi khi luu/bo loc." & vbCrLf & _
        "Sheet: " & ws.Name & vbCrLf & _
        "Loi: " & Err.Description, _
        vbExclamation, "LOI"

End Sub


'====================================================
' LAN 2
' MO KHOA TAT CA -> KHOI PHUC LOC -> KHOA LAI
'====================================================
Private Sub KhoiPhucLoc(ByVal wb As Workbook)

    Dim ws As Worksheet
    Dim MatKhau As String

    Dim TrangThaiKhoa As Object

    Dim DicSheet As Object
    Dim DicField As Object
    Dim DicLoc As Object

    Dim Key As Variant
    Dim FieldNum As Long
    Dim DiaChi As String

    Dim SoKhoiPhuc As Long
    Dim SoBoQua As Long

    MatKhau = "0943836131"

    If gLocDaLuu Is Nothing Then

        gChoKhoiPhuc = False
        gTenWorkbook = ""

        MsgBox _
            "Khong con trang thai loc de khoi phuc.", _
            vbExclamation, "BO LOC"

        Exit Sub

    End If


    Set TrangThaiKhoa = _
        CreateObject("Scripting.Dictionary")


    Application.ScreenUpdating = False
    Application.EnableEvents = False

    On Error GoTo XuLyLoi


    '================================================
    ' 1. MO KHOA TAT CA SHEET CAN KHOI PHUC
    '================================================
    For Each ws In wb.Worksheets

        If ws.Visible = xlSheetVisible Then

            If gLocDaLuu.Exists(ws.Name) Then

                TrangThaiKhoa(ws.Name) = _
                    ws.ProtectContents

                If ws.ProtectContents Then

                    On Error Resume Next
                    Err.Clear

                    ws.Unprotect Password:=MatKhau

                    If Err.Number <> 0 Or _
                       ws.ProtectContents Then

                        TrangThaiKhoa(ws.Name) = "BOQUA"
                        SoBoQua = SoBoQua + 1

                    End If

                    Err.Clear
                    On Error GoTo XuLyLoi

                End If

            End If

        End If

    Next ws


    '================================================
    ' 2. KHOI PHUC BO LOC KHI SHEET DA MO HOAN TOAN
    '================================================
    For Each ws In wb.Worksheets

        If ws.Visible = xlSheetVisible Then

            If gLocDaLuu.Exists(ws.Name) Then

                If TrangThaiKhoa(ws.Name) <> "BOQUA" Then

                    If ws.ProtectContents = False Then

                        Set DicSheet = _
                            gLocDaLuu(ws.Name)

                        Set DicField = _
                            DicSheet("Fields")

                        DiaChi = _
                            DicSheet("Range")


                        'Hien het truoc
                        If ws.FilterMode Then
                            ws.ShowAllData
                        End If


                        'Neu nut Filter da mat thi tao lai
                        If ws.AutoFilterMode = False Then

                            ws.Range(DiaChi).AutoFilter

                        End If


                        'Khoi phuc tung cot
                        For Each Key In DicField.Keys

                            FieldNum = CLng(Key)

                            Set DicLoc = _
                                DicField(Key)


                            If DicLoc("CoC2") Then

                                ws.Range(DiaChi).AutoFilter _
                                    Field:=FieldNum, _
                                    Criteria1:=DicLoc("C1"), _
                                    Operator:=DicLoc("OP"), _
                                    Criteria2:=DicLoc("C2")

                            Else

                                If DicLoc("OP") <> 0 Then

                                    ws.Range(DiaChi).AutoFilter _
                                        Field:=FieldNum, _
                                        Criteria1:=DicLoc("C1"), _
                                        Operator:=DicLoc("OP")

                                Else

                                    ws.Range(DiaChi).AutoFilter _
                                        Field:=FieldNum, _
                                        Criteria1:=DicLoc("C1")

                                End If

                            End If

                        Next Key


                        SoKhoiPhuc = _
                            SoKhoiPhuc + 1

                    End If

                End If

            End If

        End If

    Next ws


    '================================================
    ' 3. KHOA LAI
    '================================================
    For Each ws In wb.Worksheets

        If TrangThaiKhoa.Exists(ws.Name) Then

            If TrangThaiKhoa(ws.Name) <> "BOQUA" Then

                If TrangThaiKhoa(ws.Name) = True Then

                    KhoaSheet ws, MatKhau

                End If

            End If

        End If

    Next ws


    Set gLocDaLuu = Nothing

    gChoKhoiPhuc = False
    gTenWorkbook = ""


    Application.EnableEvents = True
    Application.ScreenUpdating = True


    MsgBox _
        "DA KHOI PHUC BO LOC CU." & vbCrLf & vbCrLf & _
        "Sheet da khoi phuc: " & SoKhoiPhuc & vbCrLf & _
        "Sheet bo qua: " & SoBoQua, _
        vbInformation, "BO LOC"

    Exit Sub


XuLyLoi:

    On Error Resume Next

    For Each ws In wb.Worksheets

        If TrangThaiKhoa.Exists(ws.Name) Then

            If TrangThaiKhoa(ws.Name) = True Then

                If ws.ProtectContents = False Then
                    KhoaSheet ws, MatKhau
                End If

            End If

        End If

    Next ws

    Application.EnableEvents = True
    Application.ScreenUpdating = True

    MsgBox _
        "Co loi khi khoi phuc bo loc." & vbCrLf & _
        "Sheet: " & ws.Name & vbCrLf & _
        "Loi: " & Err.Description, _
        vbExclamation, "LOI"

End Sub


'====================================================
' KHOA LAI DUNG CAU HINH MACRO CUA BAN
'====================================================
Private Sub KhoaSheet( _
    ByVal ws As Worksheet, _
    ByVal MatKhau As String)

    ws.Protect _
        Password:=MatKhau, _
        DrawingObjects:=False, _
        Contents:=True, _
        Scenarios:=True, _
        AllowFiltering:=True, _
        AllowUsingPivotTables:=True

End Sub
_______________________________________

2. Macro này làm được những gì?

Khi chạy, macro sẽ lần lượt kiểm tra toàn bộ các sheet trong file Excel đang làm việc.

Nó chỉ xử lý những sheet có trạng thái:

xlSheetVisible

Tức là những sheet đang hiển thị bình thường.

Các sheet:

Hidden
VeryHidden

sẽ được bỏ qua hoàn toàn.

3. Nếu sheet đang bị khóa thì sao?

Macro kiểm tra bằng:

DangKhoa = ws.ProtectContents

Nếu sheet đang khóa, macro sẽ tạm thời mở khóa:

ws.Unprotect Password:=MatKhau

Sau đó mới thực hiện bỏ điều kiện lọc.

Khi xử lý xong, nếu sheet ban đầu đang khóa thì macro tự động khóa lại.

4. Macro có xóa luôn nút Filter không?

Không.

Phần:

If ws.FilterMode Then
    ws.ShowAllData
End If

chỉ có tác dụng xóa điều kiện lọc hiện tại và hiển thị lại toàn bộ dữ liệu.

Các nút mũi tên Filter ở dòng tiêu đề vẫn được giữ nguyên.

Ví dụ trước khi chạy:

Tên hàng ▼
A
B
C

Bạn đang lọc chỉ còn mặt hàng A.

Sau khi chạy macro, toàn bộ A, B, C sẽ hiện lại nhưng nút ▼ vẫn còn.

5. Vì sao dùng ActiveWorkbook thay vì ThisWorkbook?

Đây là điểm rất quan trọng nếu macro của bạn được lưu trong PERSONAL.XLSB.

Không nên dùng:

For Each ws In ThisWorkbook.Worksheets

vì ThisWorkbook sẽ trỏ tới chính:

PERSONAL.XLSB

Nếu dùng như vậy, macro có thể chạy trên workbook chứa macro thay vì file Excel bạn đang thao tác.

Do đó nên dùng:

For Each ws In ActiveWorkbook.Worksheets

ActiveWorkbook chính là file Excel bạn đang mở và làm việc.

6. Vì sao macro phải dùng cùng cấu hình khóa sheet?

Nếu macro khóa sheet hiện tại của bạn đang dùng:

ws.Protect _
    Password:=MatKhau, _
    DrawingObjects:=False, _
    Contents:=True, _
    Scenarios:=True, _
    AllowFiltering:=True, _
    AllowUsingPivotTables:=True

thì macro bỏ lọc cũng nên khóa lại bằng đúng cấu hình này.

Như vậy sau khi chạy macro:

  • trạng thái bảo vệ không thay đổi;
  • Filter vẫn sử dụng được;
  • PivotTable vẫn sử dụng được;
  • không phát sinh khác biệt so với macro khóa ban đầu.

7. Cách thêm macro vào PERSONAL.XLSB

Nhấn:

Alt + F11

để mở VBA.

Trong khung bên trái, tìm:

VBAProject (PERSONAL.XLSB)

Mở:

Modules

Bạn có thể tạo một Module riêng bằng:

Insert/Chèn → Module/Mô-đun

Sau đó đổi tên Module thành:

BoLoc

rồi dán macro vào.

Nhấn:

Ctrl + S

để lưu lại PERSONAL.XLSB.

8. Có thể đặt phím tắt cho macro

Quay lại Excel rồi nhấn:

Alt + F8

Chọn:

BoTatCaBoLoc_SheetDangHien

sau đó chọn Tùy chọn/Options để gán phím tắt.

Nên chọn tổ hợp có thêm Shift để hạn chế trùng phím Excel, ví dụ:

Ctrl + Shift + L

Tuy nhiên cần lưu ý Ctrl + Shift + L vốn là phím bật/tắt Filter mặc định của Excel, vì vậy tốt hơn có thể chọn một tổ hợp khác như:

Ctrl + Shift + B

9. Kết quả sau khi chạy

Ví dụ workbook có:

TongHop          - đang hiển thị, đang lọc
ChiTiet_T1       - đang hiển thị, đang lọc
ChiTiet_T2       - đang hiển thị, không lọc
DanhMuc          - Hidden
CongThuc         - VeryHidden

Sau khi chạy macro:

TongHop          → bỏ lọc
ChiTiet_T1       → bỏ lọc
ChiTiet_T2       → giữ nguyên
DanhMuc          → không xử lý
CongThuc         → không xử lý

Nếu các sheet ban đầu đang khóa, chúng sẽ được khóa lại sau khi xử lý.

10. Khi nào nên dùng macro này?

Macro phù hợp khi bạn có workbook nhiều sheet và thường xuyên sử dụng Filter.

Thay vì phải vào từng sheet rồi chọn:

Dữ liệu → Xóa bộ lọc

bạn chỉ cần chạy một macro là tất cả các sheet đang hiển thị được đưa về trạng thái không còn điều kiện lọc.

Đặc biệt, nó phù hợp với những workbook đang sử dụng đồng thời macro khóa/mở toàn bộ sheet, vì trạng thái bảo vệ của sheet vẫn được giữ nguyên sau khi chạy.




Related posts:
Tags:

Đăng nhận xét

Mới hơn Cũ hơn

Discuss

×Close