Thắc mắc về VBA tìm kiếm Vlookup (2 người xem)

[gianghoxaotra]

Mình viết VBA do tìm trong Excel nhưng code chạy không ra kết quả, test bằng hàm Vlookup thì có kết quả. Nhờ các cao thủ chỉ giúp. Cảm ơn.

Sub TimKiem_Vlookup2()
Dim i As Long, j As Long, sArray1, sArray2, Arr()
With Sheets("Sheet2")
sArray1 = .Range(.[A2], .[A300000].End(xlUp)).Resize(, 2).Value
End With
With Sheets("Data")
.Range("AP2:AP300000").ClearContents
sArray2 = .Range(.[AK2], .[AK300000].End(xlUp)).Value
ReDim Arr(1 To UBound(sArray2, 1), 1 To 2)
For j = 1 To 500
'For j = 1 To UBound(sArray2, 1)
For i = 1 To UBound(sArray1, 1)
If Not IsEmpty(sArray2(j, 1)) And sArray1(i, 1) = UCase(sArray2(j, 1)) Then
Arr(j, 1) = sArray1(i, 2)

End If
Next
Next
.Range("AP2").Resize(j - 1, 1).Value = Arr
End With
End Sub

 

[Cá ngừ F1]

Không có file mà chỉ có code thế này ko ai giúp được bạn đâu.
Up file lên, ghi kết quả mong muốn lên xem sao nhé.

 

[gianghoxaotra]

Cảm ơn Cá Ngừ F1
Mình gửi file nè. Nhờ chỉ giúp.

File Mẫu bên dưới nhé.

 

[HungQuoc49]

Mình viết VBA do tìm trong Excel nhưng code chạy không ra kết quả, test bằng hàm Vlookup thì có kết quả. Nhờ các cao thủ chỉ giúp. Cảm ơn.

Câu lệnh này
"ReDim Arr(1 To UBound(sArray2, 1), 1 To 2)" trong file viết là
"ReDim Arr(1 To UBound(sArray2, 1), 1)" nên kết quả xuống sheet có sai khác
sửa :
Hoặc sửa lại là
"ReDim Arr(1 To UBound(sArray2, 1), 1 to 1)" thì kết quả xuống cột AP

Hoặc sửa
".Range("AP2").Resize(j - 1, 1).Value = Arr" thành
".Range("AP2").Resize(j - 1, 2).Value = Arr" thì kết quả xuống cột AQ.
---
Sửa chỗ tô đậm

 

[Vo Tinh]

Mình viết VBA do tìm trong Excel nhưng code chạy không ra kết quả, test bằng hàm Vlookup thì có kết quả.

Bạn tìm đến dòng code

Arr(j, 1) = sArray1(i, 2)

Và sửa thành như sau code sẽ chạy

Arr(j, 0) = sArray1(i, 2))

Chạy code 2 vòng lập này chắc đuối nhỉ, nhưng ra kết quả là vui rồi

 

[gianghoxaotra]

Không phải mình muốn chạy 2 dòng lập đâu, code này cũng học hỏi anh em trên đây.
Hiện tại mình phải xử lý dữ liệu với số lượng dòng khá lớn trên 100.000 dòng (rows), mình phải dùng hàm VlooKup để dò tìm kết quả thì máy chạy rất chậm, hơn nữa, hàm Vlookup càng sử dụng nhiều thì file càng nặng và càng không thể xử lý được công thức.
Có cao thủ nào có cao kiến về vấn đề khắc phục hàm Vlooup sao cho nhanh hơn hoặc nếu dùng Code VBA thì có xử lý được vấn đề dò tìm nhanh hơn không?
Suy rộng ra, đối với việc xử lý dữ liệu bằng cách lọc và rút trích thì ngôn ngữ ứng dụng lập trình nào (Excel, VBA, SPSS, Matlab, R,...) sẽ hỗ trợ tốt?

P/s: Mình có thử thay thế hàm VLookup qua hàm Sumif or Sumifs nhưng cho giá trị sai vì bảng dữ liệu có nhiều giá trị lập lại của kết quả dò tìm.

 

[gianghoxaotra]

Cảm ơn bác, mình đã xử lý lại thành công.

 

[Cá ngừ F1]

Tôi thử dùng phương thức Find, nhưng với dữ liệu kiểu này chạy ko ổn
Thử với code này xem sao:

Sub Test_Dic()
    
    Dim i&, Arr(), Source(), Data(), Itm, Dic As Object
    
    Source = Range(Sheet9.[A1], Sheet9.[B100000].End(3))
    Data = Range(Sheet7.[AK2], Sheet7.[AK100000].End(3))
    
    ReDim KQ(1 To UBound(Data), 1 To 1)
    
    Set Dic = CreateObject("scripting.dictionary")
    
    For i = 1 To UBound(Source)
        
        Dic(CStr(Source(i, 1))) = i
        
    Next
    
    For i = 1 To UBound(Data)
        Itm = CStr(Data(i, 1))
        If Dic.exists(Itm) Then
            
            KQ(i, 1) = Source(Dic.Item(Itm), 2)
        
        End If
    
    Next


    Sheet7.[AP2].Resize(i - 1, 1) = KQ


End Sub

 

[gianghoxaotra]

Code của bạn viết chạy nhanh hơn lúc đầu rất nhiều nhưng có vấn đề là khi kiểm tra kết quả với hàm Vlookup thì các giá trị chạy theo VBA sẽ lấy kết quả theo nguyên tắc xa nhất (tức từ dưới lên), còn hàm dò tìm Vlookup lấy giá trị gần nhất (từ trên xuống). Có cách nào khắc phục không bạn Cá Ngừ F1.
Mình có upload file mới lên để bạn xem lại đó.

 

[Cá ngừ F1]

Code của bạn viết chạy nhanh hơn lúc đầu rất nhiều nhưng có vấn đề là khi kiểm tra kết quả với hàm Vlookup thì các giá trị chạy theo VBA sẽ lấy kết quả theo nguyên tắc xa nhất (tức từ dưới lên), còn hàm dò tìm Vlookup lấy giá trị gần nhất (từ trên xuống). Có cách nào khắc phục không bạn Cá Ngừ F1.
Mình có upload file mới lên để bạn xem lại đó.

Bạn muốn tìm theo dòng đầu tiên, thử thay cách add key:

Sub Test_Dic_01()
    
    Dim i&, Arr(), Source(), Data(), Itm, Dic As Object
    
    Source = Range(Sheet9.[A1], Sheet9.[B100000].End(3))
    Data = Range(Sheet7.[AK2], Sheet7.[AK10000].End(3))
    
    ReDim KQ(1 To UBound(Data), 1 To 1)
    
    Set Dic = CreateObject("scripting.dictionary")
    
    For i = 1 To UBound(Source)
        If Not Dic.exists(CStr(Source(i, 1))) Then
            
            Dic.Add CStr(Source(i, 1)), i
        
        End If
        
        'Dic(CStr(Source(i, 1))) = i
        
    Next
    
    For i = 1 To UBound(Data)
        Itm = CStr(Data(i, 1))
        If Dic.exists(Itm) Then
            
            KQ(i, 1) = Source(Dic.Item(Itm), 2)
        
        End If
    
    Next


    Sheet7.[AP2].Resize(i - 1, 1) = KQ


End Sub

 

[gianghoxaotra]

Cảm ơn Cá Ngừ, mình thử và thấy ok rồi.

 

[Cá ngừ F1]

Theo lý thuyết, phương thức Find để thay cho vlookup là rất nhanh.
tuy nhiên với dữ liệu theo topic này chạy rất ỳ ạch, tôi không biết nguyên nhân. Các thành viên có thể giải thích giúp.
xin cảm ơn.