Xin viết dùng mã vba thay thế cho hàm vlookup

Mình gửi vd lên nhờ các bắc bớt chút thời gian chỉ dùm vài chiêu
Cảm ơn các bạn nhiều!!!

Mã nó đây
RightClick vào sheet "CT" ==> View Code chép cái này vào

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d, I, Vung, Ws
    Set d = CreateObject("scripting.dictionary")
    Set Ws = Sheets("MA")
    Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 3)
        If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
            If Target.Count = 1 Then
                For I = 1 To UBound(Vung)
                    d.Add Vung(I, 1), Array(Vung(I, 2), Vung(I, 3))
                Next I
                    If d.exists(UCase(Target.Value)) Then
                        Target.Offset(, 1) = d.Item(UCase(Target.Value))(0)
                        Target.Offset(, 2) = d.Item(UCase(Target.Value))(1)
                    End If
            End If
         End If
End Sub

Thân

Cái ni cũng vừa đủ sòai nề

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B4:B99")) Is Nothing Then
Dim Rng As Range, sRng As Range, Sh As Worksheet

Set Sh = ThisWorkbook.Worksheets("MA")
Set Rng = Sh.Range(Sh., Sh..End(xlDown))
Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
If sRng Is Nothing Then
MsgBox "Nothing"
Else
Target.Offset(, 1).Resize(, 2).Value = sRng.Offset(, 1).Resize(, 2).Value
End If
End If
End Sub

Sao mình dùng code nay nếu mã hành hóa lá chữ vd như A,B,C,D.. thì ok nhưng khi mã hàng là số thì khg dc. Mong các bác chỉ giáo. Mình khg lót file đc

Chuyển Key về dạng chuỗi, chỉnh lại tí tẹo
d.Add UCase(Vung(I, 1)), Array(Vung(I, 2), Vung(I, 3))

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d, I, Vung, Ws
    Set d = CreateObject("scripting.dictionary")
    Set Ws = Sheets("MA")
    Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 3)
        If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
            If Target.Count = 1 Then
                For I = 1 To UBound(Vung)
                    d.Add UCase(Vung(I, 1)), Array(Vung(I, 2), Vung(I, 3))
                Next I
                    If d.exists(UCase(Target.Value)) Then
                        Target.Offset(, 1) = d.Item(UCase(Target.Value))(0)
                        Target.Offset(, 2) = d.Item(UCase(Target.Value))(1)
                    End If
            End If
         End If
End Sub

Xin hỏi các anh chị nếu tên sheet có dấu thì sửa code này thế nào ạ

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d, I, Vung, Ws
    Dim tensheet As String
    tensheet = "ng" & ChrW(7841) & "ch s" & ChrW(7899)
    Set d = CreateObject("scripting.dictionary")
    Set Ws = Sheets(tensheet)
    Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 3)
    If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
        If Target.Count = 1 Then
            For I = 1 To UBound(Vung)
                d.Add Vung(I, 1), Array(Vung(I, 2), Vung(I, 3))
            Next I
                If d.exists(UCase(Target.Value)) Then
                    Target.Offset(, 1) = d.Item(UCase(Target.Value))(0)
                    Target.Offset(, 2) = d.Item(UCase(Target.Value))(1)
                End If
        End If
     End If
End Sub

www.giaiphapexcel.com/diendan/threads/xin-vi%E1%BA%BFt-d%C3%B9ng-m%C3%A3-vba-thay-th%E1%BA%BF-cho-h%C3%A0m-vlookup.63761/

Khóa học SprinGO phù hợp

Khóa học Power PI – Ứng dung trong Nhân sự

TỔNG QUAN KHÓA HỌC: POWER BI CHO NGÀNH NHÂN SỰ Khóa học Power BI cho Nhân sự được thiết kế dành riêng cho các...

Xem khóa học