Help me - giúp Code lọc dữ liệu theo danh sách có sẵn sử dụng advanced filter trong VBA

[Sonychuong]

Hi các bậc thầy cô, A/C trong Diễn đàn.
Em có 1 code lọc dữ liệu theo danh sách có sẵn, mà code VBA em viết chỉnh sửa hoài nó ko chạy ra . vì VBA của em rất gà nên tìm mọi cách mà code vẫn không chạy được theo ý muốn. Em kính nhờ các bậc thầy cô, A/C trong diễn đàn giúp em với .(P/s : Dùng hàm Advanced filter của Excel vẫn được nhưng nó rất bất tiện thi phải lọc nhiều)

file đính kèm có 2 sheet trong đó :
- Sheet "Doanh thu" là dữ liệu nguồn (có thể tới hơn 5000 dòng) : cần phải lọc dữ liệu trong sheet này
- Sheet "Danh sach Loc" là dữ liệu đưa vào để Sheet "Doanh thu" đối chiếu lọc ra

Yêu cầu : Dòng code VBA cho hàm advanced filter để lọc dữ liệu trong sheet "Doanh thu" theo danh sách có sẵn trong Sheet "Danh sach Loc" mà không cần copy dữ liệu

Code như sau :

Sub Loc()
Dim sh As Worksheet
Dim rg As Range
Dim Criteria_rg As Range
Dim lr As Long

Set sh = Sheet2
lr = Sheet2.Cells(Rows.Count, 2).End(xlUp).Row
Set rg = Sheets("Doanh thu").Range("F5:MT1281")
Set Criteria_rg = Sheets("Sheet2").Range("B2" & lr)

rg.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Criteria_rg, Unique:=False

End Sub


Sub XOALOC()
ActiveSheet.ShowAllData
End Sub


Xin cảm ơn ạ !

 

[tigertiger]

Hi các bậc thầy cô, A/C trong Diễn đàn.
Em có 1 code lọc dữ liệu theo danh sách có sẵn, mà code VBA em viết chỉnh sửa hoài nó ko chạy ra . vì VBA của em rất gà nên tìm mọi cách mà code vẫn không chạy được theo ý muốn. Em kính nhờ các bậc thầy cô, A/C trong diễn đàn giúp em với .(P/s : Dùng hàm Advanced filter của Excel vẫn được nhưng nó rất bất tiện thi phải lọc nhiều)

file đính kèm có 2 sheet trong đó :
- Sheet "Doanh thu" là dữ liệu nguồn (có thể tới hơn 5000 dòng) : cần phải lọc dữ liệu trong sheet này
- Sheet "Danh sach Loc" là dữ liệu đưa vào để Sheet "Doanh thu" đối chiếu lọc ra

Yêu cầu : Dòng code VBA cho hàm advanced filter để lọc dữ liệu trong sheet "Doanh thu" theo danh sách có sẵn trong Sheet "Danh sach Loc" mà không cần copy dữ liệu

Code như sau :

Sub Loc()
Dim sh As Worksheet
Dim rg As Range
Dim Criteria_rg As Range
Dim lr As Long

Set sh = Sheet2
lr = Sheet2.Cells(Rows.Count, 2).End(xlUp).Row
Set rg = Sheets("Doanh thu").Range("F5:MT1281")
Set Criteria_rg = Sheets("Sheet2").Range("B2" & lr)

rg.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Criteria_rg, Unique:=False

End Sub


Sub XOALOC()
ActiveSheet.ShowAllData
End Sub


Xin cảm ơn ạ !

Sai vùng dữ liệu tùm lum,
Tạm sửa thế này, so sánh với cũ và rút ra cho riêng bạn

Sub Loc()
    Dim sh As Worksheet
    Dim rg As Range
    Dim Criteria_rg As Range
    Dim lr As Long
   
   
   
    Set sh = Sheet2
    lr = Sheet2.Cells(Rows.Count, 2).End(xlUp).Row
    Set rg = Sheets("Doanh thu").Range("A3:Y38")
    Set Criteria_rg = Sheets("Danh sach loc").Range("B2:B" & lr)
   
    rg.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Criteria_rg, Unique:=False

End Sub

 

[Sonychuong]

Sai vùng dữ liệu tùm lum,
Tạm sửa thế này, so sánh với cũ và rút ra cho riêng bạn

Sub Loc()
    Dim sh As Worksheet
    Dim rg As Range
    Dim Criteria_rg As Range
    Dim lr As Long
  
  
  
    Set sh = Sheet2
    lr = Sheet2.Cells(Rows.Count, 2).End(xlUp).Row
    Set rg = Sheets("Doanh thu").Range("A3:Y38")
    Set Criteria_rg = Sheets("Danh sach loc").Range("B2:B" & lr)
  
    rg.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Criteria_rg, Unique:=False

End Sub

Cảm ơn @tigertiger nhiều .

Code đã chạy được rồi .