Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [c5]) Is Nothing Then
Dim Rng As Range, sRng As Range, cRng As Range
Dim Sh As Worksheet, MyAdd As String
Set Sh = Worksheets("Sheet1")
Set Rng = Sh.Range(Sh.[B10], Sh.[B65500].End(xlUp))
[A10].Resize(Rng.Rows.Count, 8).Clear
Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
MyAdd = sRng.Address
Do
If cRng Is Nothing Then
Set cRng = sRng.Offset(, -1).Resize(, 9)
Else
Set cRng = Union(cRng, sRng.Offset(, -1).Resize(, 9))
End If
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
End If
[A10].Resize(cRng.Rows.Count, 9).Value = cRng.Value
End If
End Sub
Bạn thông cảm, do cách tìm và lọc với mã trùng trong bảng dữ liệu, nên trình độ mình chỉ làm được bây nhiêu thôi (chưa tìm hiểu được cách ngắn gọn, dễ hiểu hơn), còn VD của bạn thì nếu làm mình sẽ áp dụng như bài mình đã làm, bạn làm thử đi nhé cho quen, nếu gặp trục trặc, nhắn cho mình, mình làm giúp cho nhé. Thân!Tôi có xem ví dụ và thấy rất hay và ứng dụng rất phổ biến nhưng do công thức quá phức tạp nên tôi ứng dụng không được .Xin bác Cop có thể giúp tôi tạo công thức đó thành 1 hàm trong êxcl được ko ? như thế dễ dùng hơn. Chân thành cám ơn bác rất nhiều !!!(tôi có gởi file mẫu đính kèm)