Thay hàm vlookup bằng code

[satthuvae]

Em chào Anh/Chị
Nhờ Anh/Chị xem giúp em. Em có File muốn sử dụng làm vlooup thay bằng code em không biết mình viết code như thế nào.
Nhờ Anh/Chị xem code của em, code này được Thầy Bate chỉ giùm ạ.
Em ấn nút "cập nhật họ tên" ở Sheet "tổng hợp", cột E hiện tại em không biết làm sao sửa code để lấy thông tin ở cột "E" bên sheet "khai báo"
Nhờ Anh/Chị giúp em, em sửa code như thế nào được kết quả ạ. Em xin cám ơn ạ

 

[VetMini]

VLookup có hai cách sử dụng.
Một là dò theo khoảng, bảng dò phải được sắp xếp theo thứ tự. Hai là dò chính xác, bảng dò không cần sắp xếp.
Bạn muốn trường hợp nào thì nêu cho rõ.

 

[Thóc Sama]

Em chào Anh/Chị
Nhờ Anh/Chị xem giúp em. Em có File muốn sử dụng làm vlooup thay bằng code em không biết mình viết code như thế nào.
Nhờ Anh/Chị xem code của em, code này được Thầy Bate chỉ giùm ạ.
Em ấn nút "cập nhật họ tên" ở Sheet "tổng hợp", cột E hiện tại em không biết làm sao sửa code để lấy thông tin ở cột "E" bên sheet "khai báo"
Nhờ Anh/Chị giúp em, em sửa code như thế nào được kết quả ạ. Em xin cám ơn ạ

Bạn dùng thử

Sub GPE()
    Dim Rng As Range, i&
    With Sheets("Khai bao")
        Set Rng = .Range("B2:E" & .Range("B" & Rows.Count).End(xlUp).Row)
    End With
    With Sheets("Tong hop")
        For i = 2 To .Range("C" & Rows.Count).End(xlUp).Row
            If IsError(Application.VLookup(.Cells(i, 3), Rng, 4, False)) Then
                .Cells(i, 5) = "No Data"
            Else
                .Cells(i, 5) = Application.VLookup(.Cells(i, 3), Rng, 4, False)
            End If
        Next i
    End With
End Sub

 

[VetMini]

Bạn dùng thử
...
If IsError(Application.VLookup(.Cells(i, 3), Rng, 4, False)) Then
.Cells(i, 5) = "No Data"
Else
.Cells(i, 5) = Application.VLookup(.Cells(i, 3), Rng, 4, False)
End If

Code này theo thông thường thì phải thực hiện công việc lookup 1,5 lần (1 lần nếu không tìm ra, 2 lần nếu tìm ra).
VLookup tìm chính xác không hẳn là hàm hiệu quả. Chỉnh lại thành 1 lần:
varTim = Application.VLookup(.Cells(i, 3), Rng, 4, False)
If Not IsError(varTim) Then...

 

[satthuvae]

Bạn dùng thử

Sub GPE()
    Dim Rng As Range, i&
    With Sheets("Khai bao")
        Set Rng = .Range("B2:E" & .Range("B" & Rows.Count).End(xlUp).Row)
    End With
    With Sheets("Tong hop")
        For i = 2 To .Range("C" & Rows.Count).End(xlUp).Row
            If IsError(Application.VLookup(.Cells(i, 3), Rng, 4, False)) Then
                .Cells(i, 5) = "No Data"
            Else
                .Cells(i, 5) = Application.VLookup(.Cells(i, 3), Rng, 4, False)
            End If
        Next i
    End With
End Sub

Anh ơi em hỏi 1 chút ạ
Em copy vào rùi ạ, ấn nút chạy "cập nhật họ tên" vẫn không nhảy ạ
Anh xem giúp em với ạ

 

[Thóc Sama]

Anh ơi em hỏi 1 chút ạ
Em copy vào rùi ạ, ấn nút chạy "cập nhật họ tên" vẫn không nhảy ạ
Anh xem giúp em với ạ
View attachment 292640

Máy mình nó nhảy điên đảo ấy chứ
Thêm cách nữa cho bạn chọn nha

Sub GPE()
    Dim Dic As Object, Key, Arr()
    Dim i&, k&, sArr(), Res(), Lr&
    Set Dic = CreateObject("Scripting.Dictionary")
    On Error Resume Next
    With Sheets("Khai bao")
        Lr = .Range("B" & Rows.Count).End(xlUp).Row
        Arr = .Range("B2:E" & Lr).Value
    End With
    For i = 1 To UBound(Arr)
        Key = Arr(i, 1) * 1
        If Not Dic.exists(Key) Then Dic.Add (Key), Arr(i, 4)
    Next i
    With Sheets("Tong hop")
        Lr = .Range("C" & Rows.Count).End(xlUp).Row
        .Range("E2:E" & Lr) = ""
        sArr = .Range("C2:C" & Lr).Value
        ReDim Res(1 To UBound(sArr), 1 To 1)
        For i = 1 To UBound(sArr)
            k = k + 1
            Key = sArr(i, 1) * 1
            If Dic.exists(Key) Then
                Res(k, 1) = Dic.Item(Key)
            Else
                Res(k, 1) = "No Data"
            End If
        Next i
        .Range("E2").Resize(k, 1).Value = Res
    End With
    Set Dic = Nothing
End Sub

 

[satthuvae]

Máy mình nó nhảy điên đảo ấy chứ
Thêm cách nữa cho bạn chọn nha

Sub GPE()
    Dim Dic As Object, Key, Arr()
    Dim i&, k&, sArr(), Res(), Lr&
    Set Dic = CreateObject("Scripting.Dictionary")
    On Error Resume Next
    With Sheets("Khai bao")
        Lr = .Range("B" & Rows.Count).End(xlUp).Row
        Arr = .Range("B2:E" & Lr).Value
    End With
    For i = 1 To UBound(Arr)
        Key = Arr(i, 1) * 1
        If Not Dic.exists(Key) Then Dic.Add (Key), Arr(i, 4)
    Next i
    With Sheets("Tong hop")
        Lr = .Range("C" & Rows.Count).End(xlUp).Row
        .Range("E2:E" & Lr) = ""
        sArr = .Range("C2:C" & Lr).Value
        ReDim Res(1 To UBound(sArr), 1 To 1)
        For i = 1 To UBound(sArr)
            k = k + 1
            Key = sArr(i, 1) * 1
            If Dic.exists(Key) Then
                Res(k, 1) = Dic.Item(Key)
            Else
                Res(k, 1) = "No Data"
            End If
        Next i
        .Range("E2").Resize(k, 1).Value = Res
    End With
    Set Dic = Nothing
End Sub

Dạ cám ơn anh được rùi ạ.
Anh ơi nhờ anh em copy code của anh vào module 1, để chỉ cần ấn nút "cập nhật kết quả" có được không ạ
Em thử làm copy vào nhưng bị lỗi ạ. Nhờ Anh xem giúp em ạ

 

[Thóc Sama]

Dạ cám ơn anh được rùi ạ.
Anh ơi nhờ anh em copy code của anh vào module 1, để chỉ cần ấn nút "cập nhật kết quả" có được không ạ
Em thử làm copy vào nhưng bị lỗi ạ. Nhờ Anh xem giúp em ạ

Dòng cuối code trong module 1 bạn thêm Call GPE như hình

 

[satthuvae]

Máy mình nó nhảy điên đảo ấy chứ
Thêm cách nữa cho bạn chọn nha

Sub GPE()
    Dim Dic As Object, Key, Arr()
    Dim i&, k&, sArr(), Res(), Lr&
    Set Dic = CreateObject("Scripting.Dictionary")
    On Error Resume Next
    With Sheets("Khai bao")
        Lr = .Range("B" & Rows.Count).End(xlUp).Row
        Arr = .Range("B2:E" & Lr).Value
    End With
    For i = 1 To UBound(Arr)
        Key = Arr(i, 1) * 1
        If Not Dic.exists(Key) Then Dic.Add (Key), Arr(i, 4)
    Next i
    With Sheets("Tong hop")
        Lr = .Range("C" & Rows.Count).End(xlUp).Row
        .Range("E2:E" & Lr) = ""
        sArr = .Range("C2:C" & Lr).Value
        ReDim Res(1 To UBound(sArr), 1 To 1)
        For i = 1 To UBound(sArr)
            k = k + 1
            Key = sArr(i, 1) * 1
            If Dic.exists(Key) Then
                Res(k, 1) = Dic.Item(Key)
            Else
                Res(k, 1) = "No Data"
            End If
        Next i
        .Range("E2").Resize(k, 1).Value = Res
    End With
    Set Dic = Nothing
End Sub

Em gửi lại nhờ a xem em copy không biết có đúng không ạ
Em cám ơn anh ạ

Bài đã được tự động gộp: 11/7/23

Dòng cuối code trong module 1 bạn thêm Call GPE như hình
View attachment 292643

Em cám ơn anh nhiều ạ

 

[Thóc Sama]

Em gửi lại nhờ a xem em copy không biết có đúng không ạ
Em cám ơn anh ạ

Bài đã được tự động gộp: 11/7/23

Em cám ơn anh nhiều ạ

Bạn xem ở #8 mình có hướng dẫn rồi.

 

[satthuvae]

Bạn xem ở #8 mình có hướng dẫn rồi.

Em làm được rùi ạ
Em cám ơn anh nhiều ạ