Viết code VBA thay cho dùng hàm vlookup

[minhduongct]

Vấn đề của e trong topic này là: thay vì dùng hàm vlookup và kéo xuống mỗi khi phát sinh thêm chứng từ, vậy mọi người có cách nào hướng dẫn e viết một đoạn code trên sheets chungtu và đoạn code này sẽ chạy thay cho hàm vlookup mỗi khi e nhập mã tài sản thì cột DVT và Tên Tài Sản nó sẽ tự hiện và khi cột Mã Tài Sản trống thì các cột còn lại trống mà e không cần phải viết hàm vlookup và kèo dài xuống như vậy khi chứng từ phát sinh một lượng lớn thì cái sheet của e nó chạy cực kì chậm.

 

[doveandrose]

Muốn bấm nút sau khi nhập thì:

Option Explicit
Sub GPE_Vlookup()
Dim I As Long, Kq(), DL(), Nguon(), Itm, Dic As Object
With Sheet1
    [COLOR=#ff0000][SIZE=3][B]DL = Range(.[C10], .[C65000].End(3)).Resize(, 6)[/B][/SIZE][/COLOR]
End With
With Sheet2
    [COLOR=#ff0000][SIZE=3][B]Nguon = Range(.[E9], .[E65000].End(3))[/B][/SIZE][/COLOR]
    ReDim Kq(1 To UBound(Nguon), 1 To 2)
    Set Dic = CreateObject("Scripting.dictionary")
    For I = 1 To UBound(DL)
    Itm = CStr(DL(I, 1))
        If Not Dic.exists(Itm) Then
            Dic.Add CStr(DL(I, 1)), I
        End If
    Next I
    For I = 1 To UBound(Nguon)
    Itm = CStr(Nguon(I, 1))
        If Dic.exists(Itm) Then
            Kq(I, 1) = DL(Dic.Item(Itm), 4)
            Kq(I, 2) = DL(Dic.Item(Itm), 2)
        End If
    Next I
    .[F9:G65000].ClearContents
    .[F9].Resize(I - 1, 2) = Kq
Set Dic = Nothing
End With
End Sub

bắt quả tang anh rồi nha . lêu lêu

 

[doveandrose]

Gì vậy? vụ gì vậy. Nó vẫn chạy bình thường mà lị

ờ thật ra thì không trách được . chỉ là thói quen thôi
mình thì hay dùng DL = .Range
bởi vì trong đó có khi xài 1 String chứ hông phải các cell . hi hi
nhiều chuyện tí vậy thôi nếu có gì không phải bỏ qua nhé

 

[minhduongct]

Paste vào sheet Chứng từ thì xài sự kiện:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim fRng As Range, Clls As Range
  If Target.Row > 8 And Target.Column = 5 Then
    For Each Clls In Target
      If Clls.Value = "" Then
        Clls.Offset(, 1).Resize(, 2) = ""
      End If
    Set fRng = Sheet1.Range(Sheet1.[C10], Sheet1.[C65000].End(3)).Find(Clls.Value, , xlValues, xlWhole)
      If Not fRng Is Nothing Then
        Clls.Offset(, 1) = fRng.Offset(, 3).Value
        Clls.Offset(, 2) = fRng.Offset(, 1).Value
      End If
    Next
  End If
End Sub

Muốn bấm nút sau khi nhập thì:

Option Explicit
Sub GPE_Vlookup()
Dim I As Long, Kq(), DL(), Nguon(), Itm, Dic As Object
With Sheet1
    DL = Range(.[C10], .[C65000].End(3)).Resize(, 6)
End With
With Sheet2
    Nguon = Range(.[E9], .[E65000].End(3))
    ReDim Kq(1 To UBound(Nguon), 1 To 2)
    Set Dic = CreateObject("Scripting.dictionary")
    For I = 1 To UBound(DL)
    Itm = CStr(DL(I, 1))
        If Not Dic.exists(Itm) Then
            Dic.Add CStr(DL(I, 1)), I
        End If
    Next I
    For I = 1 To UBound(Nguon)
    Itm = CStr(Nguon(I, 1))
        If Dic.exists(Itm) Then
            Kq(I, 1) = DL(Dic.Item(Itm), 4)
            Kq(I, 2) = DL(Dic.Item(Itm), 2)
        End If
    Next I
    .[F9:G65000].ClearContents
    .[F9].Resize(I - 1, 2) = Kq
Set Dic = Nothing
End With
End Sub

Từ đoạn code a đưa e biến đổi vào file của e như này hoài mà không đựơc, a sửa lại dùm e với ạ

 

[A HOANG 620]

Mình có bảng dữ liệu tong hop dò tìm mã số cho ra đơn giá 1, đơn giá 2 từ bang 1, mình chỉ biết dùng vlookup nền chạy giật dò nhiều giá trị dò. Anh chị giúp mình cách nào cho chạy nhanh hơn không ạ? xin cám ơn

 

[Hoàng Tuấn 868]

Mình có bảng dữ liệu tong hop dò tìm mã số cho ra đơn giá 1, đơn giá 2 từ bang 1, mình chỉ biết dùng vlookup nền chạy giật dò nhiều giá trị dò. Anh chị giúp mình cách nào cho chạy nhanh hơn không ạ? xin cám ơn

Thấy có bài hỗ trợ tại đây rồi sao vẫn đăng lại bạn ơi.