Tăng tốc độ code trong cách lọc duy nhất và tính tổng (1 người xem)

[Cá ngừ F1]

Xin chào các anh chị trong GPE,

Em có file đính kèm, gồm 2 sheet:
- Sheet Data chưa dữ liệu: gồm 2 trường MA và DOANHTHU theo từng MA.
- Sheet Dictionary để chạy code. Mục đích của Code như sau: dùng Dictionary với 2 cách add Key, mục đích là lọc duy nhất theo MA và tính tổng doanh số theo MA đó

[video=youtube;BmIP8nRMnfo]https://www.youtube.com/watch?v=BmIP8nRMnfo&feature=youtu.be[/video]

- Cách 1 mất khoảng 3s

Sub Method01()


With Application


    .DisplayAlerts = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual


        Dim Dic As Object, i&, Arr(), STT(), T As Double
    
        T = Timer
    
        Arr = Range(Sheet1.[C2], Sheet1.[I1000000].End(3))
    
        ReDim STT(1 To UBound(Arr), 1 To 1)
    
        Set Dic = CreateObject("Scripting.Dictionary")
    
        For i = 1 To UBound(Arr)
        
            Dic(Arr(i, 7)) = Dic(Arr(i, 7)) + Arr(i, 1)
        
            STT(i, 1) = i
        Next
    
        With Sheet2
            .[B5].Resize(Dic.Count) = Application.Transpose(Dic.keys)
            .[C5].Resize(Dic.Count) = Application.Transpose(Dic.items)
            .[A5].Resize(Dic.Count) = STT
        End With
    
        MsgBox Timer - T


    .DisplayAlerts = True
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic


End With
End Sub

- Cách 2 mất hơn 4s

Sub Method02()


With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    
        Dim Dic As Object, i&, Arr(), STT(), T As Double
    
        T = Timer
    
        Arr = Range(Sheet1.[C2], Sheet1.[I1000000].End(3))
    
        ReDim STT(1 To UBound(Arr), 1 To 1)
    
        Set Dic = CreateObject("Scripting.Dictionary")
    
        For i = 1 To UBound(Arr)
        
            STT(i, 1) = i
        
            If Not Dic.exists(Arr(i, 7)) Then
    
                Dic.Add (Arr(i, 7)), Arr(i, 1)
    
            Else
    
                Dic.Item(Arr(i, 7)) = Dic.Item(Arr(i, 7)) + Arr(i, 1)
    
            End If
    
        Next
    
        With Sheet2
            .[F5].Resize(Dic.Count) = Application.Transpose(Dic.keys)
            .[G5].Resize(Dic.Count) = Application.Transpose(Dic.items)
            .[E5].Resize(Dic.Count) = STT
        End With
    
        MsgBox Timer - T
    
    .DisplayAlerts = True
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic


End With


End Sub

Với dữ liệu hiện tại là hơn 200 nghìn dòng, và còn tăng thêm nữa. Do đó em muốn hỏi các anh chị để tăng tốc độ code hơn nữa, ngoài cách dùng Dictionary ra.
Em gửi file theo link đính kèm:

https://drive.google.com/file/d/0ByjpV84WDSQQZkxZZE9XR3FQdWc/view?usp=sharing

Xin cảm ơn các anh chị.

 

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

Dùng ADO thì cũng đã mất hết 3s rồi.

 

[Cá ngừ F1]

Dùng ADO thì cũng đã mất hết 3s rồi.

Anh Hai Lúa cứ gửi Code để anh em GPE học hỏi và tham khảo.
Em cảm ơn!

 

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

Anh Hai Lúa cứ gửi Code để anh em GPE học hỏi và tham khảo.
Em cảm ơn!

Xét thấy nếu như ADO nhanh hơn 2 cách của Cá Ngừ thì đưa lên, còn ngược lại thì thôi vậy. Vì ở đây mục tiêu là tăng tốc mà.

 

[Cá ngừ F1]

Bài này liệu có giải pháp nào khác tối ưu hơn không ạh?

 

[ndu96081631]

Bài này liệu có giải pháp nào khác tối ưu hơn không ạh?

Thử vầy xem có đở hơn không:

Sub Method03()
  Dim dic As Object, arr
  Dim i As Long, [COLOR=#ff0000]n As Long, lR as Long[/COLOR]
  Dim t As Double, [COLOR=#ff0000]dSum As Double[/COLOR]
  [COLOR=#ff0000]Dim sTmp As String[/COLOR]
  With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    
     t = Timer
    [COLOR=#ff0000] arr = Sheet1.Range("C2:I300000").Value[/COLOR]
     [COLOR=#ff0000]ReDim aDes(1 To UBound(arr), 1 To 3)[/COLOR]
     Set dic = CreateObject("Scripting.Dictionary")
     For i = 1 To UBound(arr)
       [COLOR=#ff0000]sTmp = CStr(arr(i, 7))
       If Len(sTmp) Then
         dSum = CDbl(arr(i, 1))
         If Not dic.Exists(sTmp) Then
           n = n + 1
           dic.Add sTmp, n
           aDes(n, 1) = n
           aDes(n, 2) = sTmp
           aDes(n, 3) = dSum
         Else
           lR = dic.Item(sTmp)
           aDes(lR, 3) = aDes(lR, 3) + dSum
         End If[/COLOR]
       End If
     Next
     [COLOR=#ff0000]If n Then
       Sheet2.Range("I5:K5").Resize(n).Value = aDes
       MsgBox Timer - t
     End If[/COLOR]
    
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
  End With
End Sub

Tôi chẳng cần phải End(xlUp) gì ráo. Đã dùng mảng thì chơi dư dư 1 chút... tuốt đến 300,000 dòng dữ liệu cũng được mà
--------------
Một vài chỗ tô màu đỏ là những chỗ khác với code của bạn (code rất bình dân, không chơi chiêu gì cả)

 

[Quang_Hải]

Thử thế này coi nhanh hơn bao nhiêu % nhé
Nhớ là phải check vào mục Microsoft Running Time

Sub Method04()
Dim t As Double
t = Timer
Dim Dic As New Dictionary, Arr1(), Arr2(), Arr3()
Dim i As Long, k As Long, x As Long
With Sheet1
   Arr1 = .Range("C2", .[C1000000].End(3)).Value
   Arr2 = .Range("I2", .[I1000000].End(3)).Value
End With
ReDim Arr3(1 To UBound(Arr1), 1 To 3)
For i = 1 To UBound(Arr1)
   If Not Dic.Exists(CStr(Arr2(i, 1))) Then
      k = k + 1
      Dic.Add CStr(Arr2(i, 1)), k
      Arr3(k, 1) = k
      Arr3(k, 2) = Arr2(i, 1)
      Arr3(k, 3) = Arr1(i, 1)
   Else
      x = Dic.Item(CStr(Arr2(i, 1)))
      Arr3(x, 3) = Arr3(x, 3) + Arr1(i, 1)
   End If
Next
Sheet2.Range("M5:O5").Resize(k).Value = Arr3
MsgBox Timer - t
End Sub

 

[ndu96081631]

Nhớ là phải check vào mục Microsoft Running Time

Cái này gọi là "ăn gian" nè!
Ai cũng biết giữa kết nối sớm và trễ có chênh lệnh nhau về thời gian mà

 

[Quang_Hải]

Cũng nói thêm cho Cá Ngừ biết là bài này phải chú ý đến lệnh Cstr(). Đây là điểm yếu của dữ liệu bạn đang sử dụng.

 

[Cá ngừ F1]

Thử thế này coi nhanh hơn bao nhiêu % nhé
Nhớ là phải check vào mục Microsoft Running Time

Sub Method04()
Dim t As Double
t = Timer
Dim Dic As New Dictionary, Arr1(), Arr2(), Arr3()
Dim i As Long, k As Long, x As Long
With Sheet1
   Arr1 = .Range("C2", .[C1000000].End(3)).Value
   Arr2 = .Range("I2", .[I1000000].End(3)).Value
End With
ReDim Arr3(1 To UBound(Arr1), 1 To 3)
For i = 1 To UBound(Arr1)
   If Not Dic.Exists(CStr(Arr2(i, 1))) Then
      k = k + 1
      Dic.Add CStr(Arr2(i, 1)), k
      Arr3(k, 1) = k
      Arr3(k, 2) = Arr2(i, 1)
      Arr3(k, 3) = Arr1(i, 1)
   Else
      x = Dic.Item(CStr(Arr2(i, 1)))
      Arr3(x, 3) = Arr3(x, 3) + Arr1(i, 1)
   End If
Next
Sheet2.Range("M5:O5").Resize(k).Value = Arr3
MsgBox Timer - t
End Sub

Ôi... A Hải dạo này có j thay đổi mà cót két khai báo rất chuẩn mực. Hì hì.
xin chân thành cảm ơn các tiền bối...chắc chắn sẽ học được rất nhiều từ những code này.

 

[Cá ngừ F1]

Cũng nói thêm cho Cá Ngừ biết là bài này phải chú ý đến lệnh Cstr(). Đây là điểm yếu của dữ liệu bạn đang sử dụng.

Wow, anh Hải, thêm Cstr() vào, tốc độ giảm còn 1/3.
Vậy câu hỏi đặt ra là với dữ liệu kiểu thế nào nên thêm hàm Cstr()? hay cảm giác thấy chậm thì thêm vào để test, hì...

 

[ndu96081631]

Wow, anh Hải, thêm Cstr() vào, tốc độ giảm còn 1/3.
Vậy câu hỏi đặt ra là với dữ liệu kiểu thế nào nên thêm hàm Cstr()? hay cảm giác thấy chậm thì thêm vào để test, hì...

Không phải thêm CStr vào sẽ giảm thời gian 1/3 đâu
Bí quyết tăng tốc ở đây là vì Hải check References "Microsoft Scripting Runtime" mà ra. Nói nôm na là ngay khi bạn khởi động file thì bạn đã có cái dic rồi
Còn nếu khai báo kiểu Dim dic as Object: Set dic = CreateObject("Scripting.Dictionary") thì khi bạn run code, dic mới được tạo
===> Điều đó dẫn đến cách check References sẽ cho tốc độ nhanh hơn
Còn cái vụ CStr phải dùng trong file của bạn là vì cột MA toàn số, sẽ có khả năng nhầm lẫn giữa "0123" và "123"
Tóm lại:
- Nếu khai báo trễ (không check References...) thì tăng tốc tối đa cũng cở 1.5s
- Nếu khai báo sớm (check References...) thì ta lợi thêm 1s nữa, chỉ còn cở 0.5s
Vậy thôi
---------------
Riêng về thuật toán, code của bạn chậm là vì dùng Application.Transpose

 

[Cá ngừ F1]

Không phải thêm CStr vào sẽ giảm thời gian 1/3 đâu
Bí quyết tăng tốc ở đây là vì Hải check References "Microsoft Scripting Runtime" mà ra. Nói nôm na là ngay khi bạn khởi động file thì bạn đã có cái dic rồi
Còn nếu khai báo kiểu Dim dic as Object: Set dic = CreateObject("Scripting.Dictionary") thì khi bạn run code, dic mới được tạo
===> Điều đó dẫn đến cách check References sẽ cho tốc độ nhanh hơn
Còn cái vụ CStr phải dùng trong file của bạn là vì cột MA toàn số, sẽ có khả năng nhầm lẫn giữa "0123" và "123"
Tóm lại:
- Nếu khai báo trễ (không check References...) thì tăng tốc tối đa cũng cở 1.5s
- Nếu khai báo sớm (check References...) thì ta lợi thêm 1s nữa, chỉ còn cở 0.5s
Vậy thôi
---------------
Riêng về thuật toán, code của bạn chậm là vì dùng Application.Transpose

Dạ, ý em thử thêm Cstr vào code của e, như ở bài #1 thì tốc độ còn 1/3 thật:

Sub Method01()


With Application


    .DisplayAlerts = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual


        Dim Dic As Object, i&, arr(), STT(), t As Double
    
        t = Timer
    
        arr = Range(Sheet1.[C2], Sheet1.[I1000000].End(3))
    
        ReDim STT(1 To UBound(arr), 1 To 1)
    
        Set Dic = CreateObject("Scripting.Dictionary")
    
        For i = 1 To UBound(arr)
        
            Dic(CStr(arr(i, 7))) = Dic(CStr(arr(i, 7))) + arr(i, 1)
        
            STT(i, 1) = i
        Next
    
        With Sheet2
            .[B5].Resize(Dic.Count) = Application.Transpose(Dic.keys)
            .[C5].Resize(Dic.Count) = Application.Transpose(Dic.items)
            .[A5].Resize(Dic.Count) = STT
        End With
    
        MsgBox Timer - t


    .DisplayAlerts = True
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic


End With
End Sub

 

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

Không phải thêm CStr vào sẽ giảm thời gian 1/3 đâu
Bí quyết tăng tốc ở đây là vì Hải check References "Microsoft Scripting Runtime" mà ra. Nói nôm na là ngay khi bạn khởi động file thì bạn đã có cái dic rồi
Còn nếu khai báo kiểu Dim dic as Object: Set dic = CreateObject("Scripting.Dictionary") thì khi bạn run code, dic mới được tạo
===> Điều đó dẫn đến cách check References sẽ cho tốc độ nhanh hơn
Còn cái vụ CStr phải dùng trong file của bạn là vì cột MA toàn số, sẽ có khả năng nhầm lẫn giữa "0123" và "123"
Tóm lại:
- Nếu khai báo trễ (không check References...) thì tăng tốc tối đa cũng cở 1.5s
- Nếu khai báo sớm (check References...) thì ta lợi thêm 1s nữa, chỉ còn cở 0.5s
Vậy thôi
---------------
Riêng về thuật toán, code của bạn chậm là vì dùng Application.Transpose

Riêng em thì em chẳng khoái cái check trong reference chút nào, cho dù nó có nhanh hơn vài giây.

 

[ndu96081631]

Dạ, ý em thử thêm Cstr vào code của e, như ở bài #1 thì tốc độ còn 1/3 thật:

Cái đó cũng không hẳn là nguyên nhân chính
Hiện tại code của tôi ở bài 6 cho tốc độ 1.5s.

Sub Method03()
'......................
     For i = 1 To UBound(arr)
      [COLOR=#ff0000] sTmp = CStr(arr(i, 7))[/COLOR]
  
     Next
 '....................
End Sub

Nếu nói như bạn, có CStr sẽ làm code tăng tốc, vậy nếu tôi bỏ CStr đi:

Sub Method03()
'......................
     For i = 1 To UBound(arr)
      [COLOR=#ff0000] sTmp = arr(i, 7)[/COLOR]
  
     Next
 '....................
End Sub

thì theo như suy đoán, tốc độ sẽ bị giảm xuống (thời gian tăng lên), đúng không?
Test thử bỏ CStr đi cũng chẳng thấy thay đổi gì, tốc độ vẫn 1.5s
Bạn nghĩ sao?

 

[Cá ngừ F1]

Để em chứng minh, ở code method 01 và method 01 có Cstr, cho tốc độ nhanh hơn thật:

[video=youtube;zLc51b-doic]https://www.youtube.com/watch?v=zLc51b-doic&feature=youtu.be[/video]

 

[ndu96081631]

Để em chứng minh, ở code method 01 và method 01 có Cstr, cho tốc độ nhanh hơn thật:

Không cần chứng minh đâu, bởi dữ liệu xuất ra chỉ có 300 dòng nên chẳng nói lên điều gì cả
Bạn thử nghiệm theo kiểu này xem:
- Sang sheet Data, gõ vào cell I2 giá trị AA00000001 rồi kéo fill đến I60000
- Xong, copy I2:I60000 paste xuống dưới đến dòng 227894 thì ngưng (đúng như độ lớn dữ liệu của bạn)
- Giờ chạy lại code, so sánh giữa có CStr và không có CStr xem cái nào hơn cái nào?

 

[Quang_Hải]

To Cá Ngừ:
Với dữ liệu của bạn thì nên có Cstr(), nhưng với dữ liệu anh NDU gợi ý để test thì nếu thêm Cstr() sẽ làm chậm code. Bạn tự nghiền ngẫm nguyên nhân nha.
Nếu file chỉ mình ta xài thì cũng nên kết nối sớm. Nhưng nếu file chia sẽ thì nên khai báo kiểu kết nối trễ. Nhanh chậm chẳng đáng bao nhiêu, quan trọng ta phải hiểu được cái nào sẽ được và mất gì.