Lọc dữ liệu khi tiêu đề bảng có nhiều dòng (1 người xem)

[lucbinh2013]

Nhờ các A/C giúp code của e nếu lọc tiêu đề có 1 dòng thì ok, nếu tiêu đề có 2 dòng thì không lọc được.
(chỉ cần nhập mã môn ở sheet IN là sẽ tự động lọc). Cám ơn A/C nhiều

 

[HUONGHCKT]

Nhờ các A/C giúp code của e nếu lọc tiêu đề có 1 dòng thì ok, nếu tiêu đề có 2 dòng thì không lọc được.
(chỉ cần nhập mã môn ở sheet IN là sẽ tự động lọc). Cám ơn A/C nhiều

Thử dùng file này xem sao. Hãy thay đổi Ô L3 của Sh In và xem kết quả.
Nếu dùng được bạn nên xóa bỏ Modul1 cho nhẹ file.

 

[lucbinh2013]

Thử dùng file này xem sao. Hãy thay đổi Ô L3 của Sh In và xem kết quả.
Nếu dùng được bạn nên xóa bỏ Modul1 cho nhẹ file.

Cám ơn HUONGHCKT rất nhiều ạ.

 

[vanthinh3101]

Nhờ các A/C giúp code của e nếu lọc tiêu đề có 1 dòng thì ok, nếu tiêu đề có 2 dòng thì không lọc được.
(chỉ cần nhập mã môn ở sheet IN là sẽ tự động lọc). Cám ơn A/C nhiều

Tôi sửa lại code Loc() của bạn
Bạn tham khảo nhé!

Sub Loc()
    Dim lR As Long
    Dim VisibleRange As Range, SourceRange As Range
    
    'Tat cap nhat man hinh
    Application.ScreenUpdating = False
    
    With Sheet1
        'Toan bo du lieu goc
        Set SourceRange = .Range("A1").CurrentRegion
        'Tat che do Filter
        .AutoFilterMode = False
        'Filter du lieu
        .Range("A2:J2").AutoFilter Field:=2, Criteria1:=Sheet2.Range("L3")
        'Du lieu da loc
        Set VisibleRange = SourceRange.SpecialCells(xlCellTypeVisible)
    End With
      
    'Tat kiem tra su kien
    Application.EnableEvents = False
    'Unhide toan bo cac dong
    Sheet2.Range("A5:J100").EntireRow.Hidden = False
    'Xoa ket qua cu
    Sheet2.Range("A5:J100").ClearContents
    'Kiem tra xem loc co ket qua hay khong?
    If VisibleRange.Rows.Count > 2 Or VisibleRange.Areas.Count > 1 Then
        With Sheet2
            'Copy du lieu da loc
            VisibleRange.Copy .Range("A5")
            'Xac dinh dong cuoi co du lieu
            lR = .Range("B" & Rows.Count).End(xlUp).Row
            'An cac dong trong
            .Rows((lR + 1) & ":100").EntireRow.Hidden = True
        End With
        Call SoThuTu
    Else    'Khong co ket qua loc thi thong bao
        MsgBox "Khong co ket qua loc du lieu", vbCritical, "GPE"
    End If
    
    'Tat che do Filter
    Sheet1.AutoFilterMode = False
    Set VisibleRange = Nothing
    'Bat kiem tra su kien
    Application.EnableEvents = True
    
    'Bat cap nhat man hinh
    Application.ScreenUpdating = True
End Sub

 

[lucbinh2013]

Tôi sửa lại code Loc() của bạn
Bạn tham khảo nhé!

Sub Loc()
    Dim lR As Long
    Dim VisibleRange As Range, SourceRange As Range
   
    'Tat cap nhat man hinh
    Application.ScreenUpdating = False
   
    With Sheet1
        'Toan bo du lieu goc
        Set SourceRange = .Range("A1").CurrentRegion
        'Tat che do Filter
        .AutoFilterMode = False
        'Filter du lieu
        .Range("A2:J2").AutoFilter Field:=2, Criteria1:=Sheet2.Range("L3")
        'Du lieu da loc
        Set VisibleRange = SourceRange.SpecialCells(xlCellTypeVisible)
    End With
     
    'Tat kiem tra su kien
    Application.EnableEvents = False
    'Unhide toan bo cac dong
    Sheet2.Range("A5:J100").EntireRow.Hidden = False
    'Xoa ket qua cu
    Sheet2.Range("A5:J100").ClearContents
    'Kiem tra xem loc co ket qua hay khong?
    If VisibleRange.Rows.Count > 2 Or VisibleRange.Areas.Count > 1 Then
        With Sheet2
            'Copy du lieu da loc
            VisibleRange.Copy .Range("A5")
            'Xac dinh dong cuoi co du lieu
            lR = .Range("B" & Rows.Count).End(xlUp).Row
            'An cac dong trong
            .Rows((lR + 1) & ":100").EntireRow.Hidden = True
        End With
        Call SoThuTu
    Else    'Khong co ket qua loc thi thong bao
        MsgBox "Khong co ket qua loc du lieu", vbCritical, "GPE"
    End If
   
    'Tat che do Filter
    Sheet1.AutoFilterMode = False
    Set VisibleRange = Nothing
    'Bat kiem tra su kien
    Application.EnableEvents = True
   
    'Bat cap nhat man hinh
    Application.ScreenUpdating = True
End Sub

Dạ cám ơn rất nhiều, em làm dược rồi ạ