hakhuongdhkt
Gnouhk
- Tham gia
- 26/8/14
- Bài viết
- 42
- Được thích
- 2
- Giới tính
- Nam
Em chào các bác,
Trước em có nhờ 1 bác trên diễn đàn viết dùm code thay thế cho hàm Vlookup, chạy rất tốt.
Nhưng gần đây do yêu cầu thay đổi, cần phải sửa lại code 1 chút như trong file.
Mục đích: e nhập Sub-Category và Quantity vào sheet "Tim kiem", sau đó chạy code để lấy các thông tin tương ứng (đầu tiên tìm được) với các Sub-Category trong các sheet 2013, 2014, 2015, 2016 mà thỏa mãn điều kiện Quantity lớn hơn Quantity đã nhập tại sheet "Tim kiem".
Tuy nhiên tốc độ chạy rất chậm (do dữ liệu tại các sheet 2013, 2014, 2015, 2016 rất lớn, mỗi sheet ~ 800k dòng).
Các bác xem có thể cải thiện tốc độ bằng cách nào không ạ?
Mong các bác giúp đỡ!
Trước em có nhờ 1 bác trên diễn đàn viết dùm code thay thế cho hàm Vlookup, chạy rất tốt.
Nhưng gần đây do yêu cầu thay đổi, cần phải sửa lại code 1 chút như trong file.
Mục đích: e nhập Sub-Category và Quantity vào sheet "Tim kiem", sau đó chạy code để lấy các thông tin tương ứng (đầu tiên tìm được) với các Sub-Category trong các sheet 2013, 2014, 2015, 2016 mà thỏa mãn điều kiện Quantity lớn hơn Quantity đã nhập tại sheet "Tim kiem".
Tuy nhiên tốc độ chạy rất chậm (do dữ liệu tại các sheet 2013, 2014, 2015, 2016 rất lớn, mỗi sheet ~ 800k dòng).
Các bác xem có thể cải thiện tốc độ bằng cách nào không ạ?
Mong các bác giúp đỡ!
Mã:
Sub Vlookup()
Application.ScreenUpdating = False
Dim arr, data, inputdata, varKey, temvl, dic As Object
Dim i As Long, j As Long, sh As Worksheet, lr As Long
Set dic = CreateObject("scripting.dictionary")
Set shtk = ThisWorkbook.Sheets(1)
lr = shtk.Range("A" & Rows.Count).End(xlUp).Row
shtk.Range("C2:H" & lr).ClearContents
inputdata = shtk.Range("A2:J" & lr).Value
For i = 1 To UBound(inputdata)
If Not dic.exists(inputdata(i, 1)) Then
dic.Add inputdata(i, 1), Array(inputdata(i, 2), inputdata(i, 3), inputdata(i, 4), inputdata(i, 5), inputdata(i, 6))
Else
temparr = dic(inputdata(i, 1))
temparr(0) = temparr(0) + inputdata(i, 2)
dic(inputdata(i, 1)) = temparr
End If
Next i
For Each varKey In dic.Keys()
flg = False
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> "Tim kiem" And sh.Name <> "Tru ton" Then
lr = sh.Range("A" & Rows.Count).End(xlUp).Row
data = sh.Range("A2:F" & lr).Value
For i = 1 To UBound(data)
If varKey = data(i, 1) Then
If dic.Item(varKey)(0) <= data(i, 6) Then
dic(data(i, 1)) = Array(data(i, 6), data(i, 2), data(i, 3), data(i, 4), data(i, 5))
flg = True
Exit For
End If
End If
Next
End If
If flg = True Then Exit For
Next
Next
With shtk
lr = .Range("A" & Rows.Count).End(xlUp).Row
If lr = 1 Then Exit Sub
.Range("C2:H" & lr).ClearContents
arr = .Range("A2:H" & lr).Value
For i = 1 To UBound(arr)
If dic.exists(arr(i, 1)) Then
arr(i, 3) = dic.Item(arr(i, 1))(1)
arr(i, 4) = dic.Item(arr(i, 1))(2)
arr(i, 5) = dic.Item(arr(i, 1))(3)
arr(i, 6) = dic.Item(arr(i, 1))(4)
arr(i, 7) = dic.Item(arr(i, 1))(0)
arr(i, 8) = arr(i, 7) - arr(i, 2)
End If
Next i
.Range("A2:H" & lr).Value = arr
End With
Application.ScreenUpdating = True
End Sub
Lần chỉnh sửa cuối:
