Hỏi về VBA vlookup 2 điều kiện dùng array để tăng tốc xử lí dữ liệu

[hoangthiem1987]

Hi all,
Mình có file excel như trên nhưng mỗi sheet có khoảng 70.000 - 80.000 dòng dữ liệu nên nếu dùng vlookup kết hợp choose thì sẽ rất chậm.
Các bro cho mình hỏi có cách nào để vlookup ra kết quả dùng VBA array để tăng tốc xử lí không ạ.
cột kết quả ở sheet TX3 vẫn để nguyên lỗi #NA
Thank các bro !

 

[leonguyenz]

Hi all,
Mình có file excel như trên nhưng mỗi sheet có khoảng 70.000 - 80.000 dòng dữ liệu nên nếu dùng vlookup kết hợp choose thì sẽ rất chậm.
Các bro cho mình hỏi có cách nào để vlookup ra kết quả dùng VBA array để tăng tốc xử lí không ạ.
cột kết quả ở sheet TX3 vẫn để nguyên lỗi #NA
Thank các bro !

Có thể bạn sử dụng công thức mảng (Ctrl+Shift+Enter), bạn thử Enter thôi xem thế nào.

 

[HUONGHCKT]

Hi all,
Mình có file excel như trên nhưng mỗi sheet có khoảng 70.000 - 80.000 dòng dữ liệu nên nếu dùng vlookup kết hợp choose thì sẽ rất chậm.
Các bro cho mình hỏi có cách nào để vlookup ra kết quả dùng VBA array để tăng tốc xử lí không ạ.
cột kết quả ở sheet TX3 vẫn để nguyên lỗi #NA
Thank các bro !

Bạn thử xem file có đáp ứng được yêu cầu không.
Hãy them dữ liệu vào 2 Sh và chạy thử.Kết quả đang để ở I2 để so sánh

 

[bebo021999]

Dùng tạm củ chuối này:
Nếu không tìm thấy thì để trống:

Sub test()
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
For Each cell In Sheets("SAP").Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    If Not dic.exists(cell & "-" & cell.Offset(, 3)) Then
    k = k + 1
    dic.Add cell & "-" & cell.Offset(, 3), k
    End If
Next
    With Sheets("TX3")
        For Each cell In .Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
            If dic.exists(cell & "-" & cell.Offset(, 5)) Then cell.Offset(, 7).Value = cell & "-" & cell.Offset(, 5)
        Next
    End With
End Sub

Nếu không tìm thấy thì để #N/A

Sub test()
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
For Each cell In Sheets("SAP").Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    If Not dic.exists(cell & "-" & cell.Offset(, 3)) Then
    k = k + 1
    dic.Add cell & "-" & cell.Offset(, 3), k
    End If
Next
    With Sheets("TX3")
        For Each cell In .Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
            If dic.exists(cell & "-" & cell.Offset(, 5)) Then
            cell.Offset(, 7).Value = cell & "-" & cell.Offset(, 5)
            Else
            cell.Offset(, 7).Value = "#N/A"
            End If
        Next
    End With
End Sub

 

[VetMini]

Dùng tạm củ chuối này:
Nếu không tìm thấy thì để trống:
...
Nếu không tìm thấy thì để #N/A
...

Hai cái gần in hệt nhau. Đặt riêng làm chi. Đổi ý mất công cóp lại.

Đầu module đặt cái này:
#Const GHI_NA_ERROR = 1
' sửa thành 0 nếu muốn không có thì để trống

Trong code sửa như vầy:
If dic.exists(cell & "-" & cell.Offset(, 5)) Then
cell.Offset(, 7).Value = cell & "-" & cell.Offset(, 5)
#If GHI_NA_ERROR Then
Else
cell.Offset(, 7).Value = "#N/A"
#End If
End If

Cả VLOOKUP và ARRAY đều là sở trường của tôi. Rất tiếc nói chuyện nửa Tây nửa Ta, dùng tiếng giang hồ Mẽo Đen, Mẽo Mễ thì lại là sở đoản nên tôi tránh giải bài này.

 

[bebo021999]

Hai cái gần in hệt nhau. Đặt riêng làm chi. Đổi ý mất công cóp lại.

Hai code này độc lập anh. Tùy thuộc vào chủ thớt muốn để trống hay lỗi mà dùng code 1 hay code 2 mà thôi.

 

[VetMini]

Hai code này độc lập anh. Tùy thuộc vào chủ thớt muốn để trống hay lỗi mà dùng code 1 hay code 2 mà thôi.

Ở đầu module có chỗ để "tuỳ ý".
Một trong những nhiệm vụ của lệnh dẫn trình dịch là đây. Chịu khó tìm hiểu cách sử dụng. Chỉ có lợi chứ không hại.

 

[leonguyenz]

Dùng tạm củ chuối này:
Nếu không tìm thấy thì để trống:
Nếu không tìm thấy thì để #N/A

Nếu theo nhu cầu tăng tốc độ xử lý, thì code chạy chậm hơn công thức trong file đó anh. Em test 50 ngàn dòng thì tốc độ hơn 3 giây.

 

[bebo021999]

Nếu theo nhu cầu tăng tốc độ xử lý, thì code chạy chậm hơn công thức trong file đó anh. Em test 50 ngàn dòng thì tốc độ hơn 3 giây.

Có thể dùng dic hay array có thể là 1 trong những cách tốt nhất trong trường hợp này, các trường hợp khác thì không biết.
Nếu k dùng code, Leo đo tốc độ cho vlookup bằng cách nào?

 

[VetMini]

Nếu theo nhu cầu tăng tốc độ xử lý, thì code chạy chậm hơn công thức trong file đó anh. Em test 50 ngàn dòng thì tốc độ hơn 3 giây.

Không nên tập cho người dùng làm nũng.
5-10 giây chả là gì cả đối với ghi dữ liệu hàng loạt. Trường hợp hàng loạt này, tôi để cho code tôi chạy 1/2 giờ là thường. Đối với tôi là dân chuyên kiểm soát code, vẫn tốt hơn phức tạp hoá code, và nhiều lúc biến thể, tuy vẫn ra kết quả đúng nhưng không đi sát với yêu cầu, rất khó kiểm định về sau.

 

[Hai Lúa Miền Tây]

Hi all,
Mình có file excel như trên nhưng mỗi sheet có khoảng 70.000 - 80.000 dòng dữ liệu nên nếu dùng vlookup kết hợp choose thì sẽ rất chậm.
Các bro cho mình hỏi có cách nào để vlookup ra kết quả dùng VBA array để tăng tốc xử lí không ạ.
cột kết quả ở sheet TX3 vẫn để nguyên lỗi #NA
Thank các bro !

Bạn dùng thử code sau nhé:

Sub CapNhatDL_HLMT()
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;IMEX=-1"""
        .Execute "Update [TX3$] a INNER JOIN [SAP$] b ON (a.[Order No] = b.[External Delivery ID]) AND (a.[Product Code] = b.Material) Set a.[Check TX3 và SAP]=b.[External Delivery ID] &  b.[Material]"
    End With
End Sub

 

[HieuCD]

Nếu theo nhu cầu tăng tốc độ xử lý, thì code chạy chậm hơn công thức trong file đó anh. Em test 50 ngàn dòng thì tốc độ hơn 3 giây.

Nếu tinh chỉnh code sẽ chạy nhanh hơn

 

[hoangthiem1987]

Có thể bạn sử dụng công thức mảng (Ctrl+Shift+Enter), bạn thử Enter thôi xem thế nào.

Mình đã dùng thử công thức mảng kết hợp hàm choose. Chạy rất chậm và có khi đứng máy luôn bạn

Bài đã được tự động gộp: 16/12/21

Bạn thử xem file có đáp ứng được yêu cầu không.
Hãy them dữ liệu vào 2 Sh và chạy thử.Kết quả đang để ở I2 để so sánh

Cảm ơn bạn rất nhiều. Mình đã thử và tốc độ xử lí khá tuyệt vời

Bài đã được tự động gộp: 16/12/21

Dùng tạm củ chuối này:
Nếu không tìm thấy thì để trống:

Sub test()
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
For Each cell In Sheets("SAP").Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    If Not dic.exists(cell & "-" & cell.Offset(, 3)) Then
    k = k + 1
    dic.Add cell & "-" & cell.Offset(, 3), k
    End If
Next
    With Sheets("TX3")
        For Each cell In .Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
            If dic.exists(cell & "-" & cell.Offset(, 5)) Then cell.Offset(, 7).Value = cell & "-" & cell.Offset(, 5)
        Next
    End With
End Sub

Nếu không tìm thấy thì để #N/A

Sub test()
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
For Each cell In Sheets("SAP").Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    If Not dic.exists(cell & "-" & cell.Offset(, 3)) Then
    k = k + 1
    dic.Add cell & "-" & cell.Offset(, 3), k
    End If
Next
    With Sheets("TX3")
        For Each cell In .Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
            If dic.exists(cell & "-" & cell.Offset(, 5)) Then
            cell.Offset(, 7).Value = cell & "-" & cell.Offset(, 5)
            Else
            cell.Offset(, 7).Value = "#N/A"
            End If
        Next
    End With
End Sub

Quá tuyệt !. Cảm ơn bạn rất nhiều. K củ chuối tý nào đâu bạn. Trước code mình xử lí mất 10p thì code này chạy chưa tới 10s.
Tiết kiệm khá nhiều thời gian á bạn.

Bài đã được tự động gộp: 16/12/21

Nếu tinh chỉnh code sẽ chạy nhanh hơn

Cảm ơn bạn. Mình dùng code của bạn bebo02199 chạy khá ổn rồi bạn

Bài đã được tự động gộp: 16/12/21

Bạn dùng thử code sau nhé:

Sub CapNhatDL_HLMT()
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;IMEX=-1"""
        .Execute "Update [TX3$] a INNER JOIN [SAP$] b ON (a.[Order No] = b.[External Delivery ID]) AND (a.[Product Code] = b.Material) Set a.[Check TX3 và SAP]=b.[External Delivery ID] &  b.[Material]"
    End With
End Sub

Cảm ơn bạn nhiều nhé !

Bài đã được tự động gộp: 16/12/21

Nếu theo nhu cầu tăng tốc độ xử lý, thì code chạy chậm hơn công thức trong file đó anh. Em test 50 ngàn dòng thì tốc độ hơn 3 giây.

Mình đang dùng code của bạn bebo021999 tốc độ xử lí 80.000 dòng khoảng 10s. Nhanh hơn bạn kéo công thức mảng rất nhiều

 

[hoangthiem1987]

Hai cái gần in hệt nhau. Đặt riêng làm chi. Đổi ý mất công cóp lại.

Đầu module đặt cái này:
#Const GHI_NA_ERROR = 1
' sửa thành 0 nếu muốn không có thì để trống

Trong code sửa như vầy:
If dic.exists(cell & "-" & cell.Offset(, 5)) Then
cell.Offset(, 7).Value = cell & "-" & cell.Offset(, 5)
#If GHI_NA_ERROR Then
Else
cell.Offset(, 7).Value = "#N/A"
#End If
End If

Cả VLOOKUP và ARRAY đều là sở trường của tôi. Rất tiếc nói chuyện nửa Tây nửa Ta, dùng tiếng giang hồ Mẽo Đen, Mẽo Mễ thì lại là sở đoản nên tôi tránh giải bài này.

Rảnh đâu mà lấy dữ liệu giống nhau mà ngồi viết VBA hả bạn. Còn mình hỏi như vậy bạn có hiểu câu hỏi không. Ok bạn giỏi tôi cũng không mượn bạn giúp. Chưa biết bạn giỏi tới đâu nhưng bạn quyền gì mà hạch họe.
Ở đây tôi cũng viết code nhưng do tốc độ chạy chậm nên nhờ mọi người giúp cho tốc độ nhanh hơn hiểu không.

Bài đã được tự động gộp: 16/12/21

Dùng tạm củ chuối này:
Nếu không tìm thấy thì để trống:

Sub test()
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
For Each cell In Sheets("SAP").Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    If Not dic.exists(cell & "-" & cell.Offset(, 3)) Then
    k = k + 1
    dic.Add cell & "-" & cell.Offset(, 3), k
    End If
Next
    With Sheets("TX3")
        For Each cell In .Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
            If dic.exists(cell & "-" & cell.Offset(, 5)) Then cell.Offset(, 7).Value = cell & "-" & cell.Offset(, 5)
        Next
    End With
End Sub

Nếu không tìm thấy thì để #N/A

Sub test()
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
For Each cell In Sheets("SAP").Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    If Not dic.exists(cell & "-" & cell.Offset(, 3)) Then
    k = k + 1
    dic.Add cell & "-" & cell.Offset(, 3), k
    End If
Next
    With Sheets("TX3")
        For Each cell In .Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
            If dic.exists(cell & "-" & cell.Offset(, 5)) Then
            cell.Offset(, 7).Value = cell & "-" & cell.Offset(, 5)
            Else
            cell.Offset(, 7).Value = "#N/A"
            End If
        Next
    End With
End Sub

Bạn coi giúp mình code vlookup cho cột I mình chỉnh dựa trên code của bạn toàn bị báo lỗi. Vlookup trên cột A trên sheetTX3 và sheet SAP để điền ngày tháng vào cột I. Mình gửi file đính kèm
Cảm ơn bạn !

 

[VetMini]

Rảnh đâu mà lấy dữ liệu giống nhau mà ngồi viết VBA hả bạn. Còn mình hỏi như vậy bạn có hiểu câu hỏi không. Ok bạn giỏi tôi cũng không mượn bạn giúp. Chưa biết bạn giỏi tới đâu nhưng bạn quyền gì mà hạch họe.
Ở đây tôi cũng viết code nhưng do tốc độ chạy chậm nên nhờ mọi người giúp cho tốc độ nhanh hơn hiểu không.
...

Ở đây ai cũng biết tôi rất ít giúp cá nhân. Cho nên bạn có mượn tôi cũng không ưng. Tôi vốn không thích những kẻ dùng tiếng Anh để nói chuyện với người Việt.
Thường thường tôi chỉ chung cho những người khác những kinh nghiệm của dân chuyên nghiệp viết code.

 

[phihndhsp]

@hoangthiem1987 Bạn quá nóng tính rồi. Thầy Vetmini nhận xét code là đúng đó bạn. Không ai viết cùng 1 nội dung mà 2 lần đâu bạn. Hoặc người ta có thể sử dụng khai báo hằng số như trên hoặc người ta viết theo kiểu truyền tham số.
Tôi dựa vào code của anh bebo viết tạm cho bạn để bạn có thể áp dụng và tùy chỉnh.

 

[bebo021999]

@phihndhsp , Hai đoạn code tại bài #4 là chọn 1 trong 2 tình huống, chủ thớt thích cái nào thì chọn 1 trong 2 (cho 2 phương án khác nhau của đáp án), chứ không phải 1 nội dung mà double code lên nhé.

@hoangthiem1987
Làm đại, sai tới đâu sửa tới đó:

Sub test()
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
For Each cell In Sheets("SAP").Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    If Not dic.exists(cell & "_" & cell.Offset(, 3)) Then
    dic.Add cell & "_" & cell.Offset(, 3), cell.Offset(, 2)
    End If
Next
    With Sheets("TX3")
        For Each cell In .Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
            If dic.exists(cell & "_" & cell.Offset(, 5)) Then
            cell.Offset(, 7).Value = cell & "_" & cell.Offset(, 5)
            cell.Offset(, 8).Value = dic(cell & "_" & cell.Offset(, 5))
            Else
            cell.Offset(, 7).Value = "#N/A"
            cell.Offset(, 8).Value = "#N/A"
            End If
        Next
    End With
End Sub

 

[VetMini]

Đúng vậy. Hai code ấy không phải là một.
Cũng như mua hai chiếc xe tải. Một chiếc thùng ở sau kín, che hàng không sợ mưa gió. Chiếc kia chỉ có cái mảng ở sau, tuy chịu mưa gió nhưng có thể chất được đồ cao hơn, và chở rơm rác dễ dọn dẹp hơn.

Cách tôi chỉ ở bài #5 là chỉ mua một chiếc xe tải, thùng kín ở sau có thể gỡ ra khi cần.

Vấn đề nằm ở chỗ:

1. Tiền chùa tội gì chả sắm 2 chiếc xe? (code VBA viết đâu có tốn kém gì?)

2. Chỉ có một tài xế, giữ 2 xe làm gì cho chật ga ra? (code cũng phải tốn công giữ - 2 cái sub's cùng tên đâu có giữ dễ dàng giữ một chỗ)

 

[phihndhsp]

@phihndhsp , Hai đoạn code tại bài #4 là chọn 1 trong 2 tình huống, chủ thớt thích cái nào thì chọn 1 trong 2 (cho 2 phương án khác nhau của đáp án), chứ không phải 1 nội dung mà double code lên nhé.

dạ anh trong lập trình thông thường người ta chia nhỏ các vấn đề để dễ quản lý và thường người ta sẽ viết theo dạng 1 cái khuôn để kết quả có thể ra theo cái mình muốn( sub hoặc function có truyền tham số). Không ai viết riêng lẻ từng cái đâu anh.
ví dụ điển hình là khuôn tạo hình rau câu. cũng là cái hoa hồng nhưng khác màu thôi anh, không ai đi viết 1 cái giống nhau tới 2 lần đâu
code của anh có thể thay bằng như thế này thì mình sẽ làm được nhiều trường hợp chỉ 1 lần viết.

Sub test(Loi as string)
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
For Each cell In Sheets("SAP").Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    If Not dic.exists(cell & "_" & cell.Offset(, 3)) Then
    dic.Add cell & "_" & cell.Offset(, 3), cell.Offset(, 2)
    End If
Next
    With Sheets("TX3")
        For Each cell In .Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
            If dic.exists(cell & "_" & cell.Offset(, 5)) Then
            cell.Offset(, 7).Value = cell & "_" & cell.Offset(, 5)
            cell.Offset(, 8).Value = dic(cell & "_" & cell.Offset(, 5))
            Else
            cell.Offset(, 7).Value = loi
            cell.Offset(, 8).Value = loi
            End If
        Next
    End With
End Sub

bài này là 1 ví dụ nè anh. muốn tổng hợp nhiều sheet thì trước tiên ta phải tổng hợp được 1 sheet và sau khi làm được 1 sheet xong ta thay sub đó thành 1 cái khuôn để chúng ta có thể thống kê được nhiều lần. Học lập trình giống như đi cua gái, chỉ cần hôn được 1 lần thì sẽ hôn được nhiều lần hihi

Liên kết: https://www.youtube.com/watch?v=QkXjhNOBs8k&list=PLBTk6L3nHx4rUZfWtuGbsjBE4FKaw_xuY&index=33

 

[VetMini]

dạ anh trong lập trình thông thường người ta chia nhỏ các vấn đề để dễ quản lý và thường người ta sẽ viết theo dạng 1 cái khuôn để kết quả có thể ra theo cái mình muốn( sub hoặc function có truyền tham số). Không ai viết riêng lẻ từng cái đâu anh.
...

Bạn không hẳn là nói với tôi, nhưng tôi cũng xin phép chỉnh chỗ rắc rối này:

Điều bạn nói ở bài trên là trường hợp khác biệt nữa.
Sub có tham số (parameter list) để tuỳ chọn đầu ra cũng có cái bất lợi của nó. Đầu tiên hết là nếu có tham số thì nó không còn được Excel cho vào danh sách Macro có thể chạy thẳng. Mà phải gọi từ một sub khác (hoặc cách gì đó).

Code ở bài #4 đưa ra hai cụm code để chọn. Các sub's này không có tham số cho nên có thể gọi ở đâu cũng được. Người dùng thích kiểu nào thì cóp cụm code ấy vào module của mình. Nếu muốn cả hai thì có thể đổi tên sub's. Và có thêm chọn lựa là viết thêm một sub khác với tham số (như ý của bạn). Tuỳ thuộc theo tham số mà gọi mọt trong hai sub's kia.

Code ở bài #5 dùng kỹ thuật lệnh dẫn trình dịch. Người dùng cóp cả cụm vào module của mình. Lúc cần chạy thì xem lại cái chỗ #Const. Sửa lại 1 hay 0 tuỳ chọn.