Tối ưu tốc độ truy vấn với 3 sheet có tổng cộng số bản ghi là 3,145,728 dòng.

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

Ví dụ mình có 1 file data, trong file data mình có 3 sheet, mỗi sheet chứa 1,048,576 bảng ghi và có 3 cột [Ten],[MaHang], [SoLuong].

Bây giờ mình làm sao ở 1 file excel khác lấy tổng hợp dữ liệu của 3 sheet theo kết quả giống như kết quả file KetQua

Do file lớn nên không đưa ở đây được. Các bạn có thể giả lập dữ liệu hoặc Download tại đây

 

[Ba Tê]

Ví dụ mình có 1 file data, trong file data mình có 3 sheet, mỗi sheet chứa 1,048,576 bảng ghi và có 3 cột [Ten],[MaHang], [SoLuong].

Bây giờ mình làm sao ở 1 file excel khác lấy tổng hợp dữ liệu của 3 sheet theo kết quả giống như kết quả file KetQua

Do file lớn nên không đưa ở đây được. Các bạn có thể giả lập dữ liệu hoặc Download tại đây

Hic!
Định thử cái Consolidate mà nó hổng chạy.
Chỉ biết mỗi cái mảng và Dic, tốn hơn 12 giây, chờ học hỏi thêm chiêu mới.
Chạy trong file Ketqua. Điều kiện là file 3TrieuDong cũng đang mở.

Public Sub GPE_Hic()
Application.ScreenUpdating = False
Dim Dic As Object, Ws As Worksheet, sArr(), dArr(1 To 10 ^ 6, 1 To 3)
Dim I As Long, J As Long, K As Long, Tem As String, t As Variant
t = Timer
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In Workbooks("3TrieuDong").Worksheets
    sArr = Ws.Range("A:C").Value2
    For I = 2 To UBound(sArr, 1)
        Tem = sArr(I, 1) & sArr(I, 2)
        If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, K
            For J = 1 To 3
                dArr(K, J) = sArr(I, J)
            Next J
        Else
            dArr(Dic.Item(Tem), 3) = dArr(Dic.Item(Tem), 3) + sArr(I, 3)
        End If
    Next I
Next Ws
[H2:J2].Resize(K) = dArr
[H2:J2].Resize(K).Sort Key1:=[H2], Key2:=[I2]
Set Dic = Nothing
Application.ScreenUpdating = True
MsgBox Timer - t
End Sub

 

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

Hic!
Chỉ biết mỗi cái mảng và Dic, tốn hơn 12 giây, chờ học hỏi thêm chiêu mới.
Chạy trong file Ketqua. Điều kiện là file 3TrieuDong cũng đang mở.

Public Sub GPE_Hic()
Application.ScreenUpdating = False
Dim Dic As Object, Ws As Worksheet, sArr(), dArr(1 To 10 ^ 6, 1 To 3)
Dim I As Long, J As Long, K As Long, Tem As String, t As Variant
t = Timer
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In Workbooks("3TrieuDong").Worksheets
    sArr = Ws.Range("A:C").Value2
    For I = 2 To UBound(sArr, 1)
        Tem = sArr(I, 1) & sArr(I, 2)
        If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, K
            For J = 1 To 3
                dArr(K, J) = sArr(I, J)
            Next J
        Else
            dArr(Dic.Item(Tem), 3) = dArr(Dic.Item(Tem), 3) + sArr(I, 3)
        End If
    Next I
Next Ws
[H2:J2].Resize(K) = dArr
[H2:J2].Resize(K).Sort Key1:=[H2], Key2:=[I2]
Set Dic = Nothing
Application.ScreenUpdating = True
MsgBox Timer - t
End Sub

Tính luôn lúc file chưa mở anh ơi. Code trên là file nguồn đang mở.
Code chạy nó báo "Out of memory"
Báo vàng tại dòng sau:

sArr = Ws.Range("A:C").Value2

 

[Ba Tê]

Tính luôn lúc file chưa mở anh ơi. Code trên là file nguồn đang mở.
Code chạy nó báo "Out of memory"
Báo vàng tại dòng sau:

sArr = Ws.Range("A:C").Value2

Tui lưu file Ketqua bằng .xlsm nên không lỗi.
Nếu "chơi kiểu" thì khai báo lại
Dim dArr(1 To 10 ^ 6, 1 To 3) cho phù hợp với .xls xem còn lỗi không.
Còn mở file luôn thì ... làm biếng. Chờ "mần" thêm xem sao.
---------------------
Uả, sao tui chạy không lỗi?

File Ketqua.xls
File 3TrieuDong.xlsx hơn 50MB
Mờ file lên mât hơn 20 giây rồi. Chạy tét.
Chỉ có lấy dữ liệu mà không mở file lên mới nhanh thôi.

Public Sub GPE_Hic()
Application.ScreenUpdating = False
Dim Dic As Object, Ws As Worksheet, sArr(), dArr(1 To 1000, 1 To 3)
Dim I As Long, J As Long, K As Long, Tem As String, t As Variant, Pat As String
t = Timer
Pat = ThisWorkbook.Path
Set Dic = CreateObject("Scripting.Dictionary")
Workbooks.Open Filename:=Pat & "\3TrieuDong.xlsx"
For Each Ws In Workbooks("3TrieuDong").Worksheets
    sArr = Ws.Range("A:C").Value2
    For I = 2 To UBound(sArr, 1)
        Tem = sArr(I, 1) & sArr(I, 2)
        If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, K
            For J = 1 To 3
                dArr(K, J) = sArr(I, J)
            Next J
        Else
            dArr(Dic.Item(Tem), 3) = dArr(Dic.Item(Tem), 3) + sArr(I, 3)
        End If
    Next I
Next Ws
Workbooks("Ketqua").Activate
[H2:J2].Resize(K) = dArr
[H2:J2].Resize(K).Sort Key1:=[H2], Key2:=[I2]
Set Dic = Nothing
Application.ScreenUpdating = True
MsgBox Timer - t
End Sub

 

[hoangduy012]

Mình xin góp ý một chút là: Muốn làm việc với dữ liệu nhiều như vậy mà trong VBA thì các bạn nên dùng truy vấn cơ sở dữ liệu chứ ko thể dùng hàm For rồi tìm từng phần tử thỏa mãn và lấy ra đc ở bài này mình xin vidu gộp 2 sheet data1 và data2 lại những dữ liệu trùng sẽ đc ghép lại và tính tổng slg.
Mô tả qua chút vì 2 sheet data1 và data2 cấu trúc dữ liệu như nhau ta chỉ cần dùng một câu lệnh truy vấn kiểu SQL như sau:

SELECTdt1.Ten,dt1.MaHang,dt1.SLG+dt2.SLG as SLG from
(SELECT [Data1$].Ten, [Data1$].MaHang, Sum([Data1$].SoLuong) AS SLG
FROM [Data1$] GROUP BY [Data1$].Ten, [Data1$].MaHang) dt1
inner join
(SELECT [Data2$].Ten, [Data2$].MaHang, Sum([Data2$].SoLuong) AS SLG FROM [Data2$] GROUP BY [Data2$].Ten, [Data2$].MaHang) dt2 on dt1.Ten = dt2.Ten and dt1.MaHang = dt2.MaHang

công việc này ADO sẽ hỗ trợ rất tốt trong việc lọc và gom dữ liệu cho chúng ta kết qua sẽ rất nhanh gấp nhiều lần nếu các bạn dùng hàm for để duyệt qua từng phần tử.
Các bạn để file kết quả cùng với file 3trieudong ở cùng một thư mục và thử chạy nhé.

 

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

Mình xin góp ý một chút là: Muốn làm việc với dữ liệu nhiều như vậy mà trong VBA thì các bạn nên dùng truy vấn cơ sở dữ liệu chứ ko thể dùng hàm For rồi tìm từng phần tử thỏa mãn và lấy ra đc ở bài này mình xin vidu gộp 2 sheet data1 và data2 lại những dữ liệu trùng sẽ đc ghép lại và tính tổng slg.
Mô tả qua chút vì 2 sheet data1 và data2 cấu trúc dữ liệu như nhau ta chỉ cần dùng một câu lệnh truy vấn kiểu SQL như sau:

SELECTdt1.Ten,dt1.MaHang,dt1.SLG+dt2.SLG as SLG from
(SELECT [Data1$].Ten, [Data1$].MaHang, Sum([Data1$].SoLuong) AS SLG
FROM [Data1$] GROUP BY [Data1$].Ten, [Data1$].MaHang) dt1
inner join
(SELECT [Data2$].Ten, [Data2$].MaHang, Sum([Data2$].SoLuong) AS SLG FROM [Data2$] GROUP BY [Data2$].Ten, [Data2$].MaHang) dt2 on dt1.Ten = dt2.Ten and dt1.MaHang = dt2.MaHang

công việc này ADO sẽ hỗ trợ rất tốt trong việc lọc và gom dữ liệu cho chúng ta kết qua sẽ rất nhanh gấp nhiều lần nếu các bạn dùng hàm for để duyệt qua từng phần tử.
Các bạn để file kết quả cùng với file 3trieudong ở cùng một thư mục và thử chạy nhé.

Cám ơn bạn,

Tôi chưa test nhưng tôi thấy có vấn đề, bạn thử test kỷ lại xem sao nhé.

 

[VetMini]

Câu truy vấn SQL như vậy là sai rồi.
nếu muốn gom dữ liệu từ nhiều bảng thì bắt buộc phải dùng Union All, sau đó mới Group lại để lấy tổng.