Tôi không biết viết code, Dùng 2 cột phụ, dùng hàm excel để lọc.
Option Explicit
Sub LocGioiTT()
Dim Rng As Range, sRng As Range
Dim MyAdd As String, jJ As Byte, DHTD As String
Set Rng = Range([Z4], [z63].End(xlUp))
[B65].CurrentRegion.Offset(3, 1).ClearContents
For jJ = 1 To 2
DHTD = Choose(jJ, "HSG", "HSTT")
Set sRng = Rng.Find(DHTD, , xlValues, xlWhole)
If Not sRng Is Nothing Then
MyAdd = sRng.Address
Do
With [d65500].End(xlUp).Offset(1, -2)
.Resize(, 25).Value = Cells(sRng.Row, "B").Resize(, 25).Value
Set sRng = Rng.FindNext(sRng)
End With
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
Else
MsgBox "Nothing"
End If
Next jJ
End SubSub LocKhac()
Dim Rng As Range, sRng As Range, Rng0 As Range
Dim MyAdd As String, jJ As Byte, GhCh As String
Dim eRw As Long
Sheets("CN").Select
Set Rng = Range("AA5:AA" & [b65500].End(xlUp).Row)
For jJ = 1 To 3
eRw = Choose(jJ, 4, 24, 45)
Cells(eRw, "AQ").CurrentRegion.Offset(2, 1).ClearContents
GhCh = Cells(eRw, "BN").Value
eRw = Choose(jJ, 20, 40, 60)
Set sRng = Rng.Find(GhCh, , xlValues, xlWhole)
If Not sRng Is Nothing Then
MyAdd = sRng.Address
Do
With Cells(eRw, "Aq").End(xlUp).Offset(1, -2)
.Resize(, 21).Value = Cells(sRng.Row, "B").Resize(, 21).Value
End With
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
End If
Next jJ
End Sub
Code lọc dạng này chẳng khó khăn gì... nhưng góp ý với bạn thế này: Giá như dữ liệu của bạn THẬT ĐÚNG CHUẨN CSDL (tức dòng tiểu đề luôn là 1 dòng và không có bất cứ cell nào bị merge) thì thậm chí dùng Advanced Filter cũng xong!
Làm đẹp cũng là nhu cầu hợp lý... Để bảo đảm CSDL chuẩn mà vẫn đẹp, tôi thấy người ta làm thế này:
Xem file này nhé, không cần nhấn nút đâu.
Nên chưa ai có thể trả lời cho bạn, chắc vậy!
