xin viết mã vba thay thế vlookup

[janeha2612]

xin các bác bớt chút thời gian chỉ giáo dùm e với ạ

 

[Hoàng Nhật Phương]

xin các bác bớt chút thời gian chỉ giáo dùm e với ạ

Xin chào janeha2612,
trong khi chờ đợi cách làm khác, bạn thử copy toàn bộ code bên dưới cho vào một Module sau đó chạy "Sub RunVlookup" xem sao nhé:

Option Explicit

Sub RunVlookup()
    Call TimKiem(Sheet1, "A", "N", Sheet3, "A", "D")
    Call TimKiem(Sheet1, "A", "P", Sheet3, "A", "C")
    Call TimKiem(Sheet1, "A", "O", Sheet2, "A", "E")
End Sub

Sub TimKiem(shDich As Worksheet, colKeyDich As String, colWri As String, _
                      shNguon As Worksheet, colKeyNguon As String, colData As String)
  
    Dim dict As Object, i As Long, LastRow As Long, AryDich, AryDich2, AryNguon, AryNguon2
    Const rW As Integer = 2
    Set dict = CreateObject("Scripting.Dictionary")
    With shNguon
        LastRow = .Range(colKeyNguon & Rows.Count).End(xlUp).Row
        AryNguon = .Range(colKeyNguon & rW & ":" & colKeyNguon & LastRow).Value
        AryNguon2 = .Range(colData & rW & ":" & colData & LastRow).Value
        For i = 1 To UBound(AryNguon, 1)
            dict.Item(AryNguon(i, 1)) = AryNguon2(i, 1)
        Next i
    End With
    With shDich
        LastRow = .Range(colKeyDich & Rows.Count).End(xlUp).Row
        AryDich = .Range(colKeyDich & rW & ":" & colKeyDich & LastRow).Value
        ReDim AryDich2(1 To UBound(AryDich, 1), 1 To 1)
        For i = 1 To UBound(AryDich, 1)
            If dict.exists(AryDich(i, 1)) Then
                AryDich2(i, 1) = dict(AryDich(i, 1))
            Else
                AryDich2(i, 1) = "NA"
            End If
        Next i
        .Range(colWri & rW & ":" & colWri & LastRow).Value = AryDich2
    End With
End Sub

 

[SA_DQ]

Bạn có thể xài macro sự kiện tại trang "Final. . " như dưới đây:

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [A2:A9999]) Is Nothing Then
    Dim Sh As Worksheet, Rng As Range, sRng As Range, WF As Object
    Dim J As Byte, Cot As Byte
    Dim MySh As String:                                 Set WF = Application.WorksheetFunction
    For J = 1 To 3
        If J = 2 Then MySh = "SI" Else MySh = "shpmt"
        Set Sh = ThisWorkbook.Worksheets(MySh)
        Set Rng = Sh.Range(Sh.[A1], Sh.[A1].End(xlDown))
        Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
        If sRng Is Nothing Then
            MsgBox "Nothing!", , "GPE.COM Xin Luu Ý!"
        Else
            Cot = Choose(J, 4, 5, 3)
            Target.Offset(, 12 + J).Value = WF.VLookup(Target.Value, Rng.Resize(, Cot), Cot, False)
        End If
    Next J
 End If
End Sub

 

[janeha2612]

Xin chào janeha2612,
trong khi chờ đợi cách làm khác, bạn thử copy toàn bộ code bên dưới cho vào một Module sau đó chạy "Sub RunVlookup" xem sao nhé:

Option Explicit

Sub RunVlookup()
    Call TimKiem(Sheet1, "A", "N", Sheet3, "A", "D")
    Call TimKiem(Sheet1, "A", "P", Sheet3, "A", "C")
    Call TimKiem(Sheet1, "A", "O", Sheet2, "A", "E")
End Sub

Sub TimKiem(shDich As Worksheet, colKeyDich As String, colWri As String, _
                      shNguon As Worksheet, colKeyNguon As String, colData As String)
 
    Dim dict As Object, i As Long, LastRow As Long, AryDich, AryDich2, AryNguon, AryNguon2
    Const rW As Integer = 2
    Set dict = CreateObject("Scripting.Dictionary")
    With shNguon
        LastRow = .Range(colKeyNguon & Rows.Count).End(xlUp).Row
        AryNguon = .Range(colKeyNguon & rW & ":" & colKeyNguon & LastRow).Value
        AryNguon2 = .Range(colData & rW & ":" & colData & LastRow).Value
        For i = 1 To UBound(AryNguon, 1)
            dict.Item(AryNguon(i, 1)) = AryNguon2(i, 1)
        Next i
    End With
    With shDich
        LastRow = .Range(colKeyDich & Rows.Count).End(xlUp).Row
        AryDich = .Range(colKeyDich & rW & ":" & colKeyDich & LastRow).Value
        ReDim AryDich2(1 To UBound(AryDich, 1), 1 To 1)
        For i = 1 To UBound(AryDich, 1)
            If dict.exists(AryDich(i, 1)) Then
                AryDich2(i, 1) = dict(AryDich(i, 1))
            Else
                AryDich2(i, 1) = "NA"
            End If
        Next i
        .Range(colWri & rW & ":" & colWri & LastRow).Value = AryDich2
    End With
End Sub

quá tuyệt, e chạy đc rồi. e cảm ơn ạ!

Bài đã được tự động gộp: 3/12/18

Bạn có thể xài macro sự kiện tại trang "Final. . " như dưới đây:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [A2:A9999]) Is Nothing Then
    Dim Sh As Worksheet, Rng As Range, sRng As Range, WF As Object
    Dim J As Byte, Cot As Byte
    Dim MySh As String:                                 Set WF = Application.WorksheetFunction
    For J = 1 To 3
        If J = 2 Then MySh = "SI" Else MySh = "shpmt"
        Set Sh = ThisWorkbook.Worksheets(MySh)
        Set Rng = Sh.Range(Sh.[A1], Sh.[A1].End(xlDown))
        Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
        If sRng Is Nothing Then
            MsgBox "Nothing!", , "GPE.COM Xin Luu Ý!"
        Else
            Cot = Choose(J, 4, 5, 3)
            Target.Offset(, 12 + J).Value = WF.VLookup(Target.Value, Rng.Resize(, Cot), Cot, False)
        End If
    Next J
End If
End Sub

em cảm ơn ạ