Tìm Name qua ID và điền vào cột kết quả (1 người xem)

[nilt02]

Chào các bác,
em có bảng dữ liệu cần điền vào (Cột A) nhờ các bác giúp vì làm thủ công dữ liệu lớn quá không thể làm xong nhanh được. Cụ thể như sau ạ:
Sheet Data em có cột A cần điền số theo ID có sẵn trong Sheet Name_ID
Ví dụ: tương ứng với mã ID là 1240 thì Name em tìm ở Sheet Name_ID là 264
sang Sheet Data em sẽ điền tương ứng ở cột Name là 264 cho tất cả dòng ID1240 đó
Cứ tương tự như vậy, nếu em làm thủ công sẽ mất time rất nhiều.
Có bác nào có cách để dò tìm tham chiếu hộ em với ạ. Em upload file cho các bác coi.
thanks các bác rất nhiều ạ!

 

[ChanhTQ@]

Bạn xài tạm với macro sau:

Sub DienMa()
 Dim Arr(), Sh As Worksheet, Rng As Range, sRng As Range
 Dim J As Long, Rws As Long, Tmr As Double
 Dim MyAdd As String

 Sheets("Data").Select:                 Tmr = Timer()
 Set Sh = ThisWorkbook.Worksheets("Name_ID")
 Rws = [b2].CurrentRegion.Rows.Count
 Arr() = Sheets("Name_ID").[b1].CurrentRegion.Value
 Set Rng = [b2].Resize(Rws)
 Set sRng = Rng.Find("ID", , xlFormulas, xlWhole)
 If Not sRng Is Nothing Then
    MyAdd = sRng.Address
    Do
        For J = 1 To UBound(Arr(), 2)
            If Arr(2, J) = sRng.Offset(, 1).Value Then
                sRng.Offset(, -1).Value = Arr(1, J)
                Exit For
            End If
        Next J
        Set sRng = Rng.FindNext(sRng)
    Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
 Else
    MsgBox "Nothing"
 End If
 [h99].End(xlUp).Offset(1).Value = Timer() - Tmr
End Sub

Nếu cần nhanh hơn thì chờ 1 macro khác!

 

[nilt02]

Cảm ơn bác nhiều ạ ^_^, bác có thể thêm cho em câu lệnh xóa hết dòng có ID sau khi điền xong ko ạ ? và hướng dẫn em cách xài cái này ntn ạ

 

[nilt02]

Bạn xài tạm với macro sau:

Sub DienMa()
 Dim Arr(), Sh As Worksheet, Rng As Range, sRng As Range
 Dim J As Long, Rws As Long, Tmr As Double
 Dim MyAdd As String

 Sheets("Data").Select:                 Tmr = Timer()
 Set Sh = ThisWorkbook.Worksheets("Name_ID")
 Rws = [b2].CurrentRegion.Rows.Count
 Arr() = Sheets("Name_ID").[b1].CurrentRegion.Value
 Set Rng = [b2].Resize(Rws)
 Set sRng = Rng.Find("ID", , xlFormulas, xlWhole)
 If Not sRng Is Nothing Then
    MyAdd = sRng.Address
    Do
        For J = 1 To UBound(Arr(), 2)
            If Arr(2, J) = sRng.Offset(, 1).Value Then
                sRng.Offset(, -1).Value = Arr(1, J)
                Exit For
            End If
        Next J
        Set sRng = Rng.FindNext(sRng)
    Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
 Else
    MsgBox "Nothing"
 End If
 [h99].End(xlUp).Offset(1).Value = Timer() - Tmr
End Sub

Nếu cần nhanh hơn thì chờ 1 macro khác!

Em thử copy Macro của bác vào thì RUN ra lỗi Complie error: expected:=
Có bác nào giải quyết hộ em với ạ