Tìm giá trị ngang hàng

[phuvuong_uk]

Dear all!
Em đang gặp vấn đề về tìm giá trị ngang hàng, nếu mà dùng filter thì sẽ rất mất time để tìm kiếm và copy. Mong mọi người giúp đỡ
Thank in advance

 

[SA_DQ]

Những mong là không cần gởi file kèm theo

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim eRw As Long
 
 eRw = [B65500].End(xlUp).Row
 If Not Intersect(Target, [c2]) Is Nothing Then
   [C3].Resize(eRw).ClearContents
   GPE [c2]
 ElseIf Not Intersect(Target, [d2]) Is Nothing Then
   [d3].Resize(eRw).ClearContents
   GPE [d2]
 ElseIf Not Intersect(Target, [e2]) Is Nothing Then
   [e3].Resize(eRw).ClearContents
   GPE [e2]
 End If
End Sub

[B]Sub GPE(Targ As Range)[/B]
 Dim Rng As Range, sRng As Range, MyAdd As String
 
 Set Rng = Range([A2], [A65500].End(xlUp))
 Set sRng = Rng.Find(Targ.Value, , xlFormulas, xlWhole)
 If Not sRng Is Nothing Then
   MyAdd = sRng.Address
   Do
      With Cells(65500, Targ.Column).End(xlUp).Offset(1)
         .Value = sRng.Offset(, 1).Value
      End With
      Set sRng = Rng.FindNext(sRng)
   Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
 End If
[B]End Sub[/B]

 

[TongDe]

Chọn Ô I2;click vào mũi tên chọn trong danh sách

 

[concogia]

Dear all!
Em đang gặp vấn đề về tìm giá trị ngang hàng, nếu mà dùng filter thì sẽ rất mất time để tìm kiếm và copy. Mong mọi người giúp đỡ
Thank in advance

Tặng bạn 2 cách làm luôn (Hàm và Code)