Code thay hàm vlookup (1 người xem)

[vinhlong]

Xin chào anh/chị
Tôi là dân newbie mới tập tành viết code, mình có viết 1 code để chạy thay hàm vlookup như file đính kèm, có 1 điều mà tui khó hiểu là: Khi dữ liệu >50k dòng thì code chạy chậm và có khi đứng hình ==> thua dùng hàm vlookup

Rất mong nhận được sự giúp đỡ của các anh chị

Trân trọng./.

 

[Quang_Hải]

Xin chào anh/chị
Tôi là dân newbie mới tập tành viết code, mình có viết 1 code để chạy thay hàm vlookup như file đính kèm, có 1 điều mà tui khó hiểu là: Khi dữ liệu >50k dòng thì code chạy chậm và có khi đứng hình ==> thua dùng hàm vlookup

Rất mong nhận được sự giúp đỡ của các anh chị

Trân trọng./.

Bài này dùng Find, hoặc dùng Dictionary mới đúng. Nếu dùng 2 vòng For thì treo máy với dữ liệu lớn.

 

[vinhlong]

Rất mong nhận được sự giúp đỡ của mọi người, mình chưa biết Dictionary nhiều, mong nhận được sự hồi âm của bạn.

Trân trọng./.

 

[Hau151978]

Code của bạn:

Sub NAM()
Dim Data As Variant, Arr As Variant, KQ As Variant
Dim k, i As Long


Data = Sheet1.Range("B5:d8").Value
Arr = Sheet2.Range("B4:B6").Value
ReDim KQ(1 To UBound(Arr), 2)
For i = 1 To UBound(Arr, 1)
    For k = 1 To UBound(Data, 1)
    
        If Arr(i, 1) = Data(k, 1) Then
             KQ(i, 0) = Data(k, 2)
             KQ(i, 1) = Data(k, 3)
        End If
    Next k
Next i
Sheet2.Range("C4").Resize(i - 1, 2).Value = KQ


End Sub

Code này có lỗi không kết thúc vòng lặp For ở trong khi đã tìm thấy giá trị, khi tìm thấy bạn phải exit for cho nhanh. Bạn thử xem, nếu tốc độ vẫn chậm thì có thể dùng dic hoặc sort cả 2 bảng theo mã sản phẩm rồi dùng vòng lặp để tìm.

 

[tiendo1988]

Bạn xem thêm ở topic này nhé:
http://www.giaiphapexcel.com/forum/...ết-dùng-mã-vba-thay-thế-cho-hàm-vlookup/page5

 

[VetMini]

Tìm theo kiểu code trên thì đương nhiên chậm. Nếu có dùng VLookup cũng chậm tuốt (tuy nhanh hơn được 1 tí vì nó sẽ thoát sau khi tìm được).

Cớ dữ liệu chục ngàn dòng trở lên thì nên bài bản.
Nếu dữ liệu đã sắp xếp thì dùng cách tìm nhị phân.
Nếu không thứ tự thì cách nhanh nhất là dùng đít sần. Thuật toán của đít sần dùng bảng băm nên rất nhanh.

 

[vinhlong]

Cám ơn mọi người đã đọc tin của tôi, tôi rất mong mn giúp hộ tôi code dictionary thay hàm vlookup. Rất cám ơn mn

 

[VetMini]

Function DungBangTra(ByVal rg As Range, ByVal col1 As Long, col2 As Long) As Object
[COLOR=#008000]' tao bang tra tuong tu nhu VLookup
' gom mot cot key va 2 cot values
' do can 2 values cho nen value cua dic la mot truong kep.
' co nhieu cach tao truong kep. Trong vi du nay ta dung array lam truong kep

' lưu ý: code này đọc thẳng trong cells. Nếu dùng array để cóp ra trước thì nhanh hơn nhưng nếu gặp range lớn phải có cách nhả bộ nhớ kẻo bị hết bộ nhớ

[/COLOR]Set DungBangTra = CreateObject("scripting.dictionary")
Dim ky As Variant
With DungBangTra
For Each ky In rg
.Item(ky.Value) = Array(ky.Offset(0, col1), ky.Offset(0, col2))
Next ky
End With
End Function

Sub NAM()
Dim Data As Variant, Arr As Variant, KQ As Variant
Dim k, i As Long

Dim bangTra As Object, valArray As Variant

Set bangTra = DungBangTra(Sheet1.Range("B5:B8"), 1, 2)
[COLOR=#ff0000]' Sheet1.Range("B5:B8") là cái range của trị cần tra, 1 là offset để lấy trị thứ nhất, 2 là cột offset để lấy trị thứ 2
' thay đổi cái range key và cột values ở trên cho phù hợp với nhu cầu
[/COLOR]
[COLOR=#008000]' Data = Sheet1.Range("B5:d8").Value
[/COLOR]Arr = Sheet2.Range("B4:B6").Value
ReDim KQ(1 To UBound(Arr), 2)
For i = 1 To UBound(Arr, 1)
    If bangTra.Exists(Arr(i, 1)) Then
        valArray = bangTra.Item(Arr(i, 1))
        KQ(i, 0) = valArray(0)
        KQ(i, 1) = valArray(1)
    End If
[COLOR=#008000]'    For k = 1 To UBound(Data, 1)
'
'        If Arr(i, 1) = Data(k, 1) Then
'             KQ(i, 0) = Data(k, 2)
'             KQ(i, 1) = Data(k, 3)
'        End If
'    Next k
[/COLOR]Next i
Sheet2.Range("C4").Resize(i - 1, 2).Value = KQ

Set bangTra = Nothing
End Sub

 

[Quang_Hải]

Cám ơn mọi người đã đọc tin của tôi, tôi rất mong mn giúp hộ tôi code dictionary thay hàm vlookup. Rất cám ơn mn

Thêm 1 cách cho bạn nghiên cứu cho nhức đầu chút.

Sub test()
Dim Data(), i As Long, Found As Range
With Sheet2
    Data = .Range("C4", .[C65536].End(3)).Resize(, 2).Value
    For i = 1 To UBound(Data)
        Set Found = Sheet1.Range("C:C").Find(Data(i, 1), , , 1)
        If Not Found Is Nothing Then
            Data(i, 2) = Found.Offset(, 1)
        End If
    Next
    .[C4].Resize(i - 1, 2) = Data
End With
End Sub

 

[vinhlong]

Mình add code quanghai1969, hpkhuong, Vetmini vào nhưng chạy chậm quá, thui chắc mình xài vlookup luôn, huhuhu

 

[duongcga]

1. Nhìn bác chủ topic này làm mình nhớ đến ngày xưa, thời mới tập tành code, cái gì cũng thích tự viết, tự làm. thư viện, hàm của ng ta có sẵn rồi, mang đũa ra gắp là xong, nhưng lại ko thích, thích tự làm lấy xài cơ. giờ thì chả quan trọng lắm, thấy thư viện có sẵn là xài luôn. nhưng nhờ trước thích tự làm nên trình nó lên cũng nhanh hơn.
2. Hàm thư viện của Excel đc code = C/C++, biên dịch ra mã máy tính rồi, nên nó chạy tốt. Các bác ko thích xài mà thích tự viết nên nó chạy chậm thôi.

 

[VetMini]

Tôi chỉ nhân dịp này để cho thấy cách nhét array vào item thôi. Chứ nhìn từ đầu đã thấy chủ thớt không dễ vừa ý.

TB. mà hàm thư viện nào vậy? theo kinh nghiệm tôi thì VLookup gặp bảng lớn nó cũng hơi đuối. Phải sort để cho nó có thể dùng phép kiếm nhị phân.

 

[Quang_Hải]

Cách này trên máy tính của mình thì với dữ liệu 50k dòng code xử lý trong 1s

Sub test2()
Dim sArr(), dArr(), i As Long, Dic As Object
Set Dic = CreateObject("scripting.dictionary")
With Sheet1
    sArr = .Range("C4", .[C65536].End(3)).Resize(, 2).Value
End With
With Sheet2
    dArr = .Range("C4", .[C65536].End(3)).Resize(, 2).Value
End With
For i = 1 To UBound(sArr)
    Dic(sArr(i, 1)) = sArr(i, 2)
Next
For i = 1 To UBound(dArr)
    If Dic.exists(dArr(i, 1)) Then
        dArr(i, 2) = Dic.Item(dArr(i, 1))
    End If
Next
Sheet2.[C4].Resize(i - 1, 2) = dArr
End Sub