Thay hàm vlookup bằng code

Liên hệ QC
S

satthuvae

Thành viên thường trực
Tham gia
12/3/09
Bài viết
381
Được thích
52
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 ạ
 

File đính kèm

  • Sửa Code.xlsb
    536.2 KB · Đọc: 11
Sắp xếp theo thời gian sắp xếp theo bầu chọn
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õ.
 
Upvote 0
satthuvae đã viết:
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 ạ
Nhấp chuột vào đây để mở rộng...
Bạn dùng thử
Mã: 
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
 
Upvote 0
Thóc Sama đã viết:
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
Nhấp chuột vào đây để mở rộng...
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...
 
Upvote 0
Thóc Sama đã viết:
Bạn dùng thử
Mã: 
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
Nhấp chuột vào đây để mở rộng...
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 ạ
1689063134020.png
 

File đính kèm

  • Sửa Code-V1.xlsb
    536.1 KB · Đọc: 6
Upvote 0
satthuvae đã viết:
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
Nhấp chuột vào đây để mở rộng...
Máy mình nó nhảy điên đảo ấy chứ
Thêm cách nữa cho bạn chọn nha
Mã: 
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
 

File đính kèm

  • Sửa Code.xlsb
    535.7 KB · Đọc: 13
Upvote 0
Thóc Sama đã viết:
Máy mình nó nhảy điên đảo ấy chứ
Thêm cách nữa cho bạn chọn nha
Mã: 
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
Nhấp chuột vào đây để mở rộng...
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 ạ
 
Upvote 0
satthuvae đã viết:
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 ạ
Nhấp chuột vào đây để mở rộng...
Dòng cuối code trong module 1 bạn thêm Call GPE như hình
1689064231606.png
 
Upvote 0
Thóc Sama đã viết:
Máy mình nó nhảy điên đảo ấy chứ
Thêm cách nữa cho bạn chọn nha
Mã: 
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
Nhấp chuột vào đây để mở rộng...
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:

Thóc Sama đã viết:
Dòng cuối code trong module 1 bạn thêm Call GPE như hình
View attachment 292643
Nhấp chuột vào đây để mở rộng...
Em cám ơn anh nhiều ạ
 

File đính kèm

  • Sửa Code -V2.xlsb
    533.9 KB · Đọc: 13
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

C
  • Question
Tạo schedule chạy code VBA
Trả lời
1
Đọc
42
quick87
quick87
son0611excel
  • Question
VBA tra cứu hình theo điều kiện
Trả lời
3
Đọc
42
Hoàng Tuấn 868
H
P
  • Question
anh em cho em xin code vba với, em xin cám ơn
Trả lời
2
Đọc
50
phantu93
P
LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
2 3 4
Trả lời
76
Đọc
1K
ptm0412
ptm0412
P
anh em cho em xin code vba với
Trả lời
0
Đọc
36
phantu93
P
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom