[THI] Tạo sổ TH NXT với tốc độ nhanh nhất, dữ liệu 65,532 dòng

Nguyễn Duy Tuân · 10/2/14

Cuộc thi tạo sổ tổ hợp nhập xuất tồn trong Excel tốc độ nhanh nhất

MỤC ĐÍCH
Trao đổi học tập để cùng nâng cao trình độ lập trình VBA về tối ưu code chạy nhanh và rõ ràng.

ĐỐI TƯỢNG THAM GIA
Là tất cả các thành viên GPE từ thành viên thường đến các Admin của GPE
Tôi cũng tham gia. Thực tế tôi đã viết code lâu rồi để phục vụ công việc quản lý kho, bản thân thấy chạy khá nhanh nhưng vẫn tin nó chưa phải hoàn hảo.
Nếu code của ai tối ưu nhất hoặc rõ ràng nhất sẽ trình bày code và giải thích cặn kẽ kỹ thuật để làm được ra nó trong topic này để mọi người tham khảo và học hỏi.

GIẢI THƯỞNG
Giải thưởng là cho tất cả thành viên của diễn đàn GPE được các bài học tốt về lập trình VBA trong Excel trong việc làm sổ sách tổng hợp.

THỜI GIAN DỰ THI, GỬI BÀI VÀ CÔNG BỐ
Dự thi từ ngày 10/02/2014.
Bài gửi chậm nhất là 12hAM ngày 15/02/2014.
Thời gian công bố kết quả đánh giá 14h 17/02/2014
Tất cả các bài dự thi, kết quả đánh giá sẽ được upload lên trang đầu của topic này.

Các bạn nén file đáp án rồi gửi bài vào email:
duytuan@bluesofts.net hoặc email của một thành viên BQT GPE (tôi bổ sung sau)
(Tôi sẽ là người nộp sớm nhất không sợ copy của người khác

)

ĐỀ BÀI:
Tôi cung cấp tập tin dữ liệu với 65,532 dòng cùng module chứa các hàm và thủ tục đo tốc tộ, cấu trúc lệnh.
Bảng dữ liệu:

Nếu các bạn thắc mắc về phương pháp lập sổ tôi sẽ giải thích bài sau
Cấu trúc code:
[GPECODE=vb]Sub DoThoiGian()
Dim T1@, T2@, Freq@, Overhead@
QueryPerformanceFrequency Freq
QueryPerformanceCounter T1
QueryPerformanceCounter T2
Overhead = T2 - T1
QueryPerformanceCounter T1

'Thủ tuc của bạn

LapSo 'Thủ tuc của bạn phải làm

'Kết thúc chạy, đo thời gian thực hiện
QueryPerformanceCounter T2
'Debug.Print (T2 - T1 - Overhead) / Freq * 1000; "milliseconds(ms)"
MsgBox "milliseconds(ms): " & (T2 - T1 - Overhead) / Freq * 1000
End Sub[/GPECODE]

DoThoiGian là thủ tục mẹ được gán vào nút lệnh "Thực hiện" trên bảng tính. Nội dung trong thủ tục này bạn không được sửa. Bạn cần phải tạo thủ tục LapSo để lập sổ tổng hợp NXT.

[GPECODE=vb]Sub LapSo()
'Code của bạn để tạo ra sổ
End Sub[/GPECODE]

Kết quả thực hiện phải ra được sổ có cấu trúc và dữ liệu như sau

Lưu ý, sổ mẫu đã được định dạng vì vậy bạn không cần viết code để định dạng để giảm các yếu tốt ảnh hưởng tới tốc độ của code.

(Nếu bạn không biết lập trình VBA có thể lập công thức Excel thông thường. Tuy nhiên nó có thể được dùng để so sánh giữa lập trình VBA "thiện chiến" thế nào với cách lập công thức Excel thông thường mà thôi).

[TIP]Hướng dẫn tính toán
Các thành viên lưu ý. Sheet "Setting" có thông tin về ngày lập sổ: Từ ngày...đến ngày với các name NGAY1, NGAY2. Điều kiện để lập sổ phải dựa vào thời gian và Loại_phieu

Lượng Tồn đầu = lượng nhập với ngày < NGAY1 - lượng xuất với ngày < NGAY1
Lượng Nhập trong kỳ = lượng nhập với ngày >= NGAY1 và ngày <= NGAY2
Lượng Xuất trong kỳ = lượng xuất với ngày >= NGAY1 và ngày <= NGAY2
Lượng tồn cuối = Lượng Tồn đầu + Lượng Nhập trong kỳ - Lượng Xuất trong kỳ

Tương tự khi tính giá trị...[/TIP]

TIÊU CHÍ ĐÁNH GIÁ
Tìm ra các code đạt tốc độ nhanh nhất. Các bài làm cố gắng trình bày dễ hiểu và kèm comment trong code để giải thích.
Tất cả các bài với các phương pháp khác nhau cũng sẽ đăng lên để chúng ta học được nhiều phương pháp từ đó có thể vận dụng linh hoạt trong các việc khác.

Xin nói trước với các bạn là ta có thể đánh giá ở mức tương đối. Tất cả các code sẽ chạy trên một máy tính. Excel sẽ được khởi động lại với mỗi code mới, mỗi code được chạy 3 lần rồi lấy tốc độ trung bình. Tất cả các bài dự thi được upload lên đây để tất cả mọi người tham khảo.

Với tinh thần cầu thị, tạo sân chơi chung cho mọi người tôi rất mong chúng ta cùng tham gia. Mong các thành viên đừng e ngại về trình độ của mình thế này thế khác, cứ xác định tham gia để học để biết mình đã làm được gì và cần cải tiến cái gì về lập trình VBA.

-----------------
Đã có bài tổng hợp kết quả test và các file có mã nguồn của các tác giả gửi. Các thành viên xem bài #175 để download.
-----------------

vodoi2x · 13/2/14

Như trên nói với thuần VBA thì sử dụng object Dictionary chưa hẳn là giải pháp tốt nhất

Qua thử nghiệm thấy rằng với trường hợp file dữ liệu ở topic này thì dùng Collection cho kết quả NHANH hơn hẳn,:

chú ý qua thử nghiệm:
- nếu số dòng dữ liệu KHO khoảng dưới 5000 --> thì nên dùng Dictionary
- còn nếu lớn hơn nữa thì nên dùng Collection,

Với giải pháp Collection
Tốc độ đã thử nghiêm và cải thiện code nhiều lần: thử trên laptop của tôi khoảng 220-240 mls cho chạy lần đầu, chạy từ lần 2 trở đi chỉ khoảng 100-125mls

Cũng tương tự trên, cần chú ý:

vodoi2x đã viết:
chú ý: Phương châm là nghiên cứu tốc độ là chính, nên coi như dữ liệu Nhập là đã chuẩn hóa (vì sub này chỉ là 1 phần code thử nghiệm mà thui)

Các bạn nên down load file về
vì Sub có tối ưu lần chạy thứ 2 code sẽ không load dữ liệu lại từ KHO, và sheet "DM VLSPHH" nữa

Tuy thế, nếu có thay đổi Dữ liệu ở 2 sheet trên thì sẽ đọc lại (thông qua sự kiện worksheet change) --> khi đó tốc độ thời gian lại như lần 1 - Thông qua 2 biến public chung Run1K và Run1D

vậy, các bạn thử chạy và báo lại tốc độ xem sao và mong nhận được góp ý, xin cám ơn

PHP:

Private Sub LapSo()
    ''Code lap so th nxt
    ''Su Dung Collections
    ''nguoi Lap: vodoi2x
    ''email: vodoi909090@yahoo.com
    ''13.02.2014
    
    Application.ScreenUpdating = False
    
    ''Khai bao cac bien can thiet
    Dim Day1 As Long, Day2 As Long, i As Long, k As Long, p As Long, c1 As Long, c2 As Long
    Static Ngay(), MaSoHH(), SoLG(), LoaiPhieu(), ThanhTien(), ColDM As Collection
    Dim soDM(), arrRes(), ColHH As Collection
    
    ''Nhap du lieu cho Day1, Day2 la 2 ngay dau va cuoi cua Ky tinh toan
    Day1 = Range("NGAY1").Value2
    Day2 = Range("NGAY2").Value2
    
    ''Neu la lan chay dau tien / hoac khi sheet KHO co sua chua  thay doi, thi
    '' nap cac du lieu tinh toan Ngay, MaSoHH, ...., ThanhTien
    If Not Run1K Then
        With Range("KHO").Resize(Range("KHO").Rows.Count - 1, 1).Offset(, 1)
            Ngay = .Value2
            MaSoHH = .Offset(, 5).Value2
            SoLG = .Offset(, 6).Value2
            LoaiPhieu = .Offset(, 8).Value2
            ThanhTien = .Offset(, 9).Value2
        End With
        Run1K = True                            ''khang dinh da chay 1 lan doc du lieu tu Sheet KHO
    End If
    
    ''Neu la lan chay dau tien / hoac khi sheet DM VLSPHH co sua chua thay doi, thi
    '' nap cac du lieu tinh toan cho SoDM, va ColDM dung dinh vi vi tri theo Key
    If Run1D Then
         p = ColDM.Count
    Else
        ''nap cac du lieu tinh toan cho SoDM - tuong ung
        soDM = Range("DMVLSPHH").Resize(Range("DMVLSPHH").Rows.Count - 1, 3).Offset(1).Value2
        p = UBound(soDM)
        
        ''Khoi tao collection ColDM luu giu Key la MaHH va Item la gia tri Ten, DVT trong sheet DM VLSPHH
        Set ColDM = New Collection
        On Error Resume Next
        For i = 1 To p
            ColDM.Add Item:=Array(soDM(i, 2), soDM(i, 3)), Key:=soDM(i, 1)
        Next i
        On Error GoTo 0
        Run1D = True                            ''khang dinh da chay 1 lan doc du lieu tu Sheet DM VLSPHH
    End If
     
    ReDim arrRes(1 To p + 10, 1 To 12) ''Mang chua ket qua gom 12 cot
    Set ColHH = New Collection '' khoi tao collection dung de giu vi tri cua 1 MaHH trong mang arrRes
    k = 0
    
    
    For i = 1 To UBound(Ngay) ''Duyet tung dong chung tu cua Kho de xet ngay
        If Ngay(i, 1) <= Day2 Then ''chi xet cac ngay nho hon ngay cuoi ky Day2
           
            If Ngay(i, 1) < Day1 Then       ''ton dau ky
                c1 = 5:     c2 = 6
                If LoaiPhieu(i, 1) Like "X" Then
                    SoLG(i, 1) = -SoLG(i, 1)
                    ThanhTien(i, 1) = -ThanhTien(i, 1)
                End If
            Else                           ''trong ky
                If LoaiPhieu(i, 1) Like "N" Then
                        c1 = 7:     c2 = 8
                Else:   c1 = 9:     c2 = 10:    End If
            End If
            
            On Error Resume Next
            p = ColHH.Item(MaSoHH(i, 1))
            
            If Err.Number <> 0 Then             ''Truong hop CHUA CO MaHH trong collecttion colHH, nen ta cong vao, va gan gia tri vao arrRes
                On Error GoTo 0
                k = k + 1
                ColHH.Add Item:=k, Key:=MaSoHH(i, 1)
                arrRes(k, 2) = MaSoHH(i, 1)     ''gan gia tri cot 1 cot 2 mang arrRes (la TT va Maso)
                arrRes(k, c1) = SoLG(i, 1)
                arrRes(k, c2) = ThanhTien(i, 1)
            Else                                ''case Err.Number <> 0  ''Truong hop DA CO MaHH trong collecttion,
                On Error GoTo 0
                arrRes(p, c1) = arrRes(p, c1) + SoLG(i, 1)
                arrRes(p, c2) = arrRes(p, c2) + ThanhTien(i, 1)
            End If ''Err.Number <> 0
        End If ''Ngay(i, 1) <= Day2
    Next i ''FOR i
    
    ''tinh toan TON CUOI KY & tinh Tong GrandTotal cua cac cot Thanh tien: TonDK, NHAP, XUAT, & TON CUOI
    ''bang cach duyet cac dong cua arrRes
    p = k + 1
    For i = 1 To k
        arrRes(i, 1) = i
        On Error Resume Next
        arrRes(i, 3) = ColDM.Item(arrRes(i, 2))(0) ''gan gia tri cot 3 cot 4 mang arrRes (la TenHH va Donvi) duoc lay tu  colDM
        arrRes(i, 4) = ColDM.Item(arrRes(i, 2))(1)
        On Error GoTo 0
        
        arrRes(i, 11) = arrRes(i, 5) + arrRes(i, 7) - arrRes(i, 9) ''Tinh ton cuoi ky cot 11 cot 12 cua Ket qua arrRes
        arrRes(i, 12) = arrRes(i, 6) + arrRes(i, 8) - arrRes(i, 10)
        
        arrRes(p, 6) = arrRes(p, 6) + arrRes(i, 6) ''Tinh Tong GrandTotal cua cac cot Thanh tien: TonDK, NHAP, XUAT, & TON CUOI trong arrRes
        arrRes(p, 8) = arrRes(p, 8) + arrRes(i, 8)
        arrRes(p, 10) = arrRes(p, 10) + arrRes(i, 10)
        arrRes(p, 12) = arrRes(p, 12) + arrRes(i, 12)
    Next i
    
  
    ''Xuat ket qua ra Sheet
    With Range("KetQuaNXT").Offset(1)
        .Resize(13, 12).ClearContents
        If k Then .Resize(p, 12) = arrRes
    End With
End Sub

Mong nhận được đóng góp, xin cảm ơn

-----------
Tái viết:
Với Collection
Vì quá trính sửa name nên mã BE1 không có tên HH và Đơn vị tính, do đoạn code này bị thiếu
thay dòng này
soDM = Range("DMVLSPHH").Resize(Range("DMVLSPHH").Rows.Count - 1, 3).Value2
thành
soDM = Range("DMVLSPHH").Resize(Range("DMVLSPHH").Rows.Count - 1, 3).Offset(1).Value2

Thiếu Offset(1), code trên cũng đã cập nhập

Hoặc các bạn down file mới đã cập nhập ...._New

kyo · 13/2/14

Nhân bài của anh vodoi2x và nhân trong một lần tình cờ tìm ra bảng so sánh tốc độ nên kyo đưa lên bảng này (bảng này có chút chủ quan của một tác giả nước ngoài vì test trên máy của họ, nhưng phần nào cũng có thể là một căn cứ so sánh).

vodoi2x · 13/2/14

vodoi2x đã viết:
chú ý qua thử nghiệm:
- nếu số dòng dữ liệu KHO khoảng dưới 5000 --> thì nên dùng Dictionary
- còn nếu lớn hơn nữa thì nên dùng Collection,

Xin lỗi mọi người, về kết luận chủ quan, Lúc trước hoa mắt hay sao ý (hoặc thử nghiệm các thời điểm khác nhau, dẫn đến kết luận sai)

Vừa thử nghiệm lại thì giải pháp Collection LUÔN LUÔN NHANH hơn hẳn Dictionnary
với mọi số dòng số liệu KHO

Mọi người có thể thử test trong file gửi kèm,

Tại Sheet chạy chương trình:
+ Sô dòng xét của KHO có thể thay đổi ở O2 (name KHO đã đặt thành name động theo O2)
+ Chạy 2 giải pháp Collection ivs Dictionnary qua các nút bấm - thời gian ghi nhận lần lượt tại cột O và P

+ các giải pháp đều đã loại bỏ trường hợp không load dữ liệu nhập lần 2 - nói cách khác luôn đọc lại dữ liệu nhập (từ 2 sheet KHO, DM VLSPHH) khi chạy chương trình (chạy lần 1 hay lần 2 , 3.... đều load lại dữ liệu nhập)

Mọi người thử nghiệm xem có thấy gì khác biệt 2 phương pháp, ứng với số dòng xét ở KHO khác nhau

Tái viết:
Với Collection
Vì quá trính sửa name nên mã BE1 không có tên HH và Đơn vị tính, do đoạn code này bị thiếu

thay dòng này
soDM = Range("DMVLSPHH").Resize(Range("DMVLSPHH").Rows.Count - 1, 3).Value2
thành
soDM = Range("DMVLSPHH").Resize(Range("DMVLSPHH").Rows.Count - 1, 3).Offset(1).Value2

Thiếu Offset(1)

Hoặc các bạn down file mới đã cập nhập _New

vodoi2x · 13/2/14

có cập nhập lại code cho bài 141 và bài 143 (đã thêm phần tái viết tại các bài đó)

Với Giải pháp Collection
Vì quá trính sửa name nên mã BE1 không có tên HH và Đơn vị tính, do đoạn code này bị thiếu

thay dòng này trong sub lapso

soDM = Range("DMVLSPHH").Resize(Range("DMVLSPHH").Rows.Co unt - 1, 3).Value2

thành

soDM = Range("DMVLSPHH").Resize(Range("DMVLSPHH").Rows.Co unt - 1, 3).Offset(1).Value2

Thiếu Offset(1)

Hoặc các bạn download file mới đã cập nhập _New tại 2 bài đó

---> lỗi này không ảnh hưởng đến kết quả số và cũng thời gian chạy , chỉ là thiếu dòng của bảng DMVTSPHH ,

--

Hoàng Trọng Nghĩa · 13/2/14

vodoi2x đã viết:
Với Giải pháp Collection
--

Với Dictionary nó có mảng chẳng hạn Dict.Keys và Dict.Items

Còn Collection mỗi lần xuất Key hay Item để có mảng đều phải dùng vòng lặp?

Với Dictionary có Dict.Exists, còn Collection phải bẫy lỗi khi Add Key phải không?

Và khi giải phóng bộ nhớ thì Dictionary có Dict.RemoveAll, còn Collection thì cứ vòng lặp cho 1 đến Coll.Count để Remove từng Item một?

Không biết nhiều về Collection cho lắm, vậy làm hơn nói rõ cho mình vấn đề này để tiện việc dùng.

Xin cám ơn.

siwtom · 13/2/14

Hoàng Trọng Nghĩa đã viết:
Với Dictionary nó có mảng chẳng hạn Dict.Keys và Dict.Items

Còn Collection mỗi lần xuất Key hay Item để có mảng đều phải dùng vòng lặp?

Có nhiều trường hợp bạn không dùng tới 2 mảng keys, items mà.

Với Dictionary có Dict.Exists, còn Collection phải bẫy lỗi khi Add Key phải không?

Và khi giải phóng bộ nhớ thì Dictionary có Dict.RemoveAll, còn Collection thì cứ vòng lặp cho 1 đến Coll.Count để Remove từng Item một?

Không biết nhiều về Collection cho lắm, vậy làm hơn nói rõ cho mình vấn đề này để tiện việc dùng.

Xin cám ơn.

Collection là class mà bạn. Bạn dùng class chán chê rồi mà.

Chỉ cần Set collection = Nothing thôi.

Mã:

Dim Coll As New Collection
....
Coll.Add ...

hoặc

Dim Coll As Collection
...
Set Coll = New Collection
Coll.Add ...
...
Set Coll = Nothing

Nếu bạn Add key đã có thì sẽ có lỗi. Vì bạn có thể truy cập tới Item hoặc bằng chỉ số 1, 2, 3, tức vd. Coll(3), Coll.Item(3) hoặc bằng key, tức vd. Coll("hichic"), Coll.Item("hichic"), vậy nếu có 2 key như nhau thì làm sao biết phải trả về Item nào?

Kiểu truy cập bằng index hoặc bằng "tên" - key thì bạn dùng chán rồi. Vd. Sheets(1), sheets("Sheet1") ...

Khi bạn Add key đã tồn tại thì sẽ có lỗi

Mã:

Err.Number = 457
Err.Description = "This key is already associated with an element of this collection"

Vậy thì cũng có thể kiểm tra cái trên để biết có key đó chưa (Exists)

Nhưng với collection khi dùng Add thì key là không bắt buộc.

Hoàng Trọng Nghĩa · 13/2/14

siwtom đã viết:
Có nhiều trường hợp bạn không dùng tới 2 mảng keys, items mà.

Em vẫn thường xuyên dùng Keys để gán vô combobox đó Thầy ơi, nó là mảng một chiều, gán cho CBB thì trở thành mảng 2 chiều 1 cột rất nhanh.

siwtom đã viết:
Nhưng với collection khi dùng Add thì key là không bắt buộc.

Cái này vẫn chưa hiểu rõ lắm ạ, làm ơn nói rõ cho em biết được không ạ?

Trong Help của Excel chỉ có một ví dụ thế này thôi, thật sự cũng chưa thấy đầy đủ lắm:

Mã:

Sub ClassNamer()


    Dim MyClasses As New Collection   [COLOR=#0000ff] ' Create a Collection object.[/COLOR]
    
    Dim Num   [COLOR=#0000ff] ' Counter for individualizing keys.[/COLOR]
    
    Dim Msg As String   [COLOR=#0000ff] ' Variable to hold prompt string.[/COLOR]
    
    Dim TheName, MyObject, NameList    [COLOR=#0000ff]' Variants to hold information.[/COLOR]
    
    Do
    
        Dim Inst As New Class1    [COLOR=#0000ff]' Create a new instance of Class1.[/COLOR]
        
        Num = Num + 1    [COLOR=#0000ff]' Increment Num, then get a name.[/COLOR]
        
        Msg = "Please enter a name for this object." & Chr(13) _
         & "Press Cancel to see names in collection."
        TheName = InputBox(Msg, "Name the Collection Items")
        
        Inst.[B][COLOR=#ff0000]InstanceName [/COLOR][/B]= TheName    [COLOR=#0000ff]' Put name in object instance.[/COLOR]
        
[COLOR=#0000ff]        ' If user entered name, add it to the collection.[/COLOR]
        If Inst.[B][COLOR=#ff0000]InstanceName [/COLOR][/B]<> "" Then
        
[COLOR=#0000ff]            ' Add the named object to the collection.[/COLOR]
            MyClasses.Add Item:=Inst, Key:=CStr(Num)
            
        End If
        
[COLOR=#0000ff]        ' Clear the current reference in preparation for next one.[/COLOR]
        Set Inst = Nothing
        
    Loop Until TheName = ""
    
    For Each MyObject In MyClasses   [COLOR=#0000ff] ' Create list of names.[/COLOR]
        NameList = NameList & MyObject.InstanceName & Chr(13)
    Next MyObject
    
[COLOR=#0000ff]    ' Display the list of names in a message box.[/COLOR]
    MsgBox NameList, , "Instance Names In MyClasses Collection"




    For Num = 1 To MyClasses.Count    [COLOR=#0000ff]' Remove name from the collection.[/COLOR]
    
        MyClasses.Remove 1    [COLOR=#0000ff]' Since collections are reindexed[/COLOR]
[COLOR=#0000ff]                ' automatically, remove the first[/COLOR]
    Next       [COLOR=#0000ff] ' member on each iteration.[/COLOR]
    
End Sub

Với biến InstanceName đặt trong Class có tên là Class1

Public InstanceName

siwtom · 13/2/14

Hoàng Trọng Nghĩa đã viết:
Em vẫn thường xuyên dùng Keys để gán vô combobox đó Thầy ơi, nó là mảng một chiều, gán cho CBB thì trở thành mảng 2 chiều 1 cột rất nhanh.

Tôi không phủ nhận là có nhiều khi cần keys, items. Tôi chỉ nói là có nhiều khi không cần.

Cái này vẫn chưa hiểu rõ lắm ạ, làm ơn nói rõ cho em biết được không ạ?

Thì có nghĩa là trong phương thức Add thì chỉ tham số đầu Item là bắt buộc còn 3 tham số khác là Optional.
Nếu nhập Key thì sau đó có thể truy cập tới Item bằng key (ngoài cách bằng index). Nếu không nhập Key thì mất khả năng này, tức chỉ truy cập tới Item bằng index thôi.

Tất nhiên nếu ta muốn dùng collection để lọc duy nhất thì ta sẽ nhập key. Tôi chỉ nhấn mạnh là key không bắt buộc. Nghĩa là "có thể, được phép nhưng không bắt buộc".

Hoàng Trọng Nghĩa · 13/2/14

siwtom đã viết:
Tôi không phủ nhận là có nhiều khi cần keys, items. Tôi chỉ nói là có nhiều khi không cần.

Thì có nghĩa là trong phương thức Add thì chỉ tham số đầu Item là bắt buộc còn 3 tham số khác là Optional.
Nếu nhập Key thì sau đó có thể truy cập tới Item bằng key (ngoài cách bằng index). Nếu không nhập Key thì mất khả năng này, tức chỉ truy cập tới Item bằng index thôi.

Tất nhiên nếu ta muốn dùng collection để lọc duy nhất thì ta sẽ nhập key. Tôi chỉ nhấn mạnh là key không bắt buộc. Nghĩa là "có thể, được phép nhưng không bắt buộc".

OK, em hiểu rồi Thầy ạ!

-----------------------------------

Trời ơi, lục lọi mãi mới ra được cái này!

Add Method (Visual Basic for Applications)

Adds a member to a Collection object.

Syntax

object.Add item, key, before, after

The Add method syntax has the following object qualifier and named arguments:

Part Description

object Required. An object expression that evaluates to an object in the Applies To list.

item Required. An expression of any type that specifies the member to add to the collection.

key Optional. A unique string expression that specifies a key string that can be used, instead of a positional index, to access a member of the collection.

before Optional. An expression that specifies a relative position in the collection. The member to be added is placed in the collection before the member identified by the before argument. If a numeric expression, before must be a number from 1 to the value of the collection's Count property. If a string expression, before must correspond to the key specified when the member being referred to was added to the collection. You can specify a before position or an after position, but not both.

after Optional. An expression that specifies a relative position in the collection. The member to be added is placed in the collection after the member identified by the after argument. If numeric, after must be a number from 1 to the value of the collection's Count property. If a string, after must correspond to the key specified when the member referred to was added to the collection. You can specify a before position or an after position, but not both.

Remarks

Whether the before or after argument is a string expression or numeric expression, it must refer to an existing member of the collection, or an error occurs.

An error also occurs if a specified key duplicates the key for an existing member of the collection.

vodoi2x · 13/2/14

Hoàng Trọng Nghĩa đã viết:
Với Dictionary nó có mảng chẳng hạn Dict.Keys và Dict.Items
Còn Collection mỗi lần xuất Key hay Item để có mảng đều phải dùng vòng lặp?
Với Dictionary có Dict.Exists, còn Collection phải bẫy lỗi khi Add Key phải không?
Và khi giải phóng bộ nhớ thì Dictionary có Dict.RemoveAll, còn Collection thì cứ vòng lặp cho 1 đến Coll.Count để Remove từng Item một?
Không biết nhiều về Collection cho lắm, vậy làm hơn nói rõ cho mình vấn đề này để tiện việc dùng.
Xin cám ơn.

so sánh 2 cái này tương đối, có thể nói Dictionary là 1 collection đặc biệt có thêm các thuộc tính methods khác và luôn dựa vào key, tuy thế collection thì có sẵn trong library của VBA, còn dictionary ta phải dẫn nhập (reference) từ Scripting Runtime Object Library

Trả lời dài vào đây e rằng làm loãng topics , nên bạn xem ở đây kỹ sẽ hiểu thêm sự khác nhau giữa 2 lớp này: http://excelicious.wordpress.com/2010/01/07/dictionary-vs-collection/

Hai Lúa Miền Tây · 14/2/14

vodoi2x đã viết:
Như trên nói với thuần VBA thì sử dụng object Dictionary chưa hẳn là giải pháp tốt nhất

Qua thử nghiệm thấy rằng với trường hợp file dữ liệu ở topic này thì dùng Collection cho kết quả NHANH hơn hẳn,:

chú ý qua thử nghiệm:
- nếu số dòng dữ liệu KHO khoảng dưới 5000 --> thì nên dùng Dictionary
- còn nếu lớn hơn nữa thì nên dùng Collection,

Với giải pháp Collection
Tốc độ đã thử nghiêm và cải thiện code nhiều lần: thử trên laptop của tôi khoảng 220-240 mls cho chạy lần đầu, chạy từ lần 2 trở đi chỉ khoảng 100-125mls

Cũng tương tự trên, cần chú ý:

PHP:

Private Sub LapSo() ''Code lap so th nxt ''Su Dung Collections ''nguoi Lap: vodoi2x ''email: vodoi909090@yahoo.com ''13.02.2014 .......

Mong nhận được đóng góp, xin cảm ơn

-----------
Tái viết:
Với Collection
Vì quá trính sửa name nên mã BE1 không có tên HH và Đơn vị tính, do đoạn code này bị thiếu
thay dòng này
soDM = Range("DMVLSPHH").Resize(Range("DMVLSPHH").Rows.Count - 1, 3).Value2
thành
soDM = Range("DMVLSPHH").Resize(Range("DMVLSPHH").Rows.Count - 1, 3).Offset(1).Value2

Thiếu Offset(1), code trên cũng đã cập nhập

Hoặc các bạn down file mới đã cập nhập ...._New

Đúng là tốc độ tuyệt vời, tuy nhiên khi chọn lại khoảng thời gian nó ra 2 kết quả khác nhau???
[video=youtube;-tKMoqtTSRg]http://www.youtube.com/watch?v=-tKMoqtTSRg&feature=youtu.be[/video]

Hoàng Trọng Nghĩa · 14/2/14

Hai Lúa Miền Tây đã viết:
Đúng là tốc độ tuyệt vời, tuy nhiên khi chọn lại khoảng thời gian nó ra 2 kết quả khác nhau???

Anh thì không bị như thế khi test trên cái file: THNXT_FAST_dulieu_vodoi2x_Collection.xls

Nhưng lại bị mất Tên Hàng và Đơn Vị Tính của một Mã Hàng.

Lê Duy Thương · 14/2/14

ăn gian như vầy được không ta ? --=0

ec ec[video=youtube_share;td0_1pA8x3w]http://youtu.be/td0_1pA8x3w[/video]

Lê Duy Thương · 14/2/14

Hai Lúa Miền Tây đã viết:
Đúng là tốc độ tuyệt vời, tuy nhiên khi chọn lại khoảng thời gian nó ra 2 kết quả khác nhau???
[video=youtube;-tKMoqtTSRg]http://www.youtube.com/watch?v=-tKMoqtTSRg&feature=youtu.be[/video]

như vậy là code vẫn chưa chính xác hả HLMTvà HTN

Hai Lúa Miền Tây · 14/2/14

Lê Duy Thương đã viết:
như vậy là code vẫn chưa chính xác hả HLMTvà HTN

Trên máy mình chạy nó thế, tuy nhiên còn chuyện xác định chính xác hay không thì phải đợi nhiều người cùng test mới đưa ra kết luận được.

vodoi2x · 14/2/14

Hoàng Trọng Nghĩa đã viết:
Nhưng lại bị mất Tên Hàng và Đơn Vị Tính của một Mã Hàng.

Đã khắc phục tại bài 144

Hai Lúa Miền Tây đã viết:
Đúng là tốc độ tuyệt vời, tuy nhiên khi chọn lại khoảng thời gian nó ra 2 kết quả khác nhau???

Cám ơn HLMT, Test lại đúng là thấy có sự sai khác, xem xét lại thì nguyên nhân chính là đây

Do muốn chạy lần 2 nhanh nên đã khai báo các biến tải dữ liệu (trong đó có SoLG() và ThanhTien()) từ kho là Static để lần 2 chạy thì không cần đọc lại dữ liệu, dẫn đến đoạn lệnh sau

PHP:

               If LoaiPhieu(i, 1) Like "X" Then
                    SoLG(i, 1) = -SoLG(i, 1)
                    ThanhTien(i, 1) = -ThanhTien(i, 1)
                End If

sẽ bị đổi dấu (âm dương) liên tục qua các lần chạy kế (2, 3,...) dẫn đến kết quả sai khác

Tôi đã chỉnh và cập nhập toàn bộ lại code mới ( ..._New1) cho - thêm 2 biến tạm tmpSoLg và tmpTien - thời gian tính chắc có tăng chút.
đã upload lên đây 3 files
+ giải pháp collection
+ giải pháp Dictionary
+ Collection vs Dictionary -- cái này không sai vì luôn load lại dữ liệu, tuy nhiên tôi cập nhập lại hợp lý hơn: thay khai báo static thành DIM cho nó giải phóng bộ nhớ sau mỗi lần chạy

Vậy các bạn download và test nhé

dưới đây chỉ show ra code lap so của trường hợp collection

PHP:

Private Sub LapSo()
    ''Code lap so th nxt
    ''Su Dung Collections
    ''nguoi Lap: vodoi2x
    ''email: vodoi909090@yahoo.com
    ''14.02.2014
     
    Application.ScreenUpdating = False
    
    ''Khai bao cac bien can thiet
    Dim Day1 As Long, Day2 As Long, i As Long, k As Long, p As Long, c1 As Long, c2 As Long
    Static Ngay(), MaSoHH(), SoLG(), LoaiPhieu(), ThanhTien(), ColDM As Collection
    Dim soDM(), arrRes(), ColHH As Collection
    Dim tmpSolg As Double, tmpTien As Double
    
    ''Nhap du lieu cho Day1, Day2 la 2 ngay dau va cuoi cua Ky tinh toan
    Day1 = Range("NGAY1").Value2
    Day2 = Range("NGAY2").Value2
    
    ''Neu la lan chay dau tien / hoac khi sheet KHO co sua chua  thay doi, thi
    '' nap cac du lieu tinh toan Ngay, MaSoHH, ...., ThanhTien
    If Not Run1K Then
        With Range("KHO").Resize(Range("KHO").Rows.Count - 1, 1).Offset(, 1)
            Ngay = .Value2
            MaSoHH = .Offset(, 5).Value2
            SoLG = .Offset(, 6).Value2
            LoaiPhieu = .Offset(, 8).Value2
            ThanhTien = .Offset(, 9).Value2
        End With
        Run1K = True                            ''khang dinh da chay 1 lan doc du lieu tu Sheet KHO
    End If
    
    ''Neu la lan chay dau tien / hoac khi sheet DM VLSPHH co sua chua thay doi, thi
    '' nap cac du lieu tinh toan cho SoDM, va ColDM dung dinh vi vi tri theo Key
    If Run1D Then
         p = ColDM.Count
    Else
        ''nap cac du lieu tinh toan cho SoDM - tuong ung
        soDM = Range("DMVLSPHH").Resize(Range("DMVLSPHH").Rows.Count - 1, 3).Offset(1).Value2
        p = UBound(soDM)
        
        ''Khoi tao collection ColDM luu giu Key la MaHH va Item la gia tri Ten, DVT trong sheet DM VLSPHH
        Set ColDM = New Collection
        On Error Resume Next
        For i = 1 To p
            ColDM.Add Item:=Array(soDM(i, 2), soDM(i, 3)), Key:=soDM(i, 1)
        Next i
        On Error GoTo 0
        Run1D = True                            ''khang dinh da chay 1 lan doc du lieu tu Sheet DM VLSPHH
    End If
     
    ReDim arrRes(1 To p + 10, 1 To 12) ''Mang chua ket qua gom 12 cot
    Set ColHH = New Collection '' khoi tao collection dung de giu vi tri cua 1 MaHH trong mang arrRes
    k = 0
    
    
    For i = 1 To UBound(Ngay) ''Duyet tung dong chung tu cua Kho de xet ngay
        If Ngay(i, 1) <= Day2 Then ''chi xet cac ngay nho hon ngay cuoi ky Day2
            tmpSolg = SoLG(i, 1)
            tmpTien = ThanhTien(i, 1)
            If Ngay(i, 1) < Day1 Then       ''ton dau ky
                c1 = 5:     c2 = 6
                If LoaiPhieu(i, 1) Like "X" Then
                    tmpSolg = -tmpSolg
                    tmpTien = -tmpTien
                End If
            Else                           ''trong ky
                If LoaiPhieu(i, 1) Like "N" Then
                        c1 = 7:     c2 = 8
                Else:   c1 = 9:     c2 = 10:    End If
            End If
            
            On Error Resume Next
            p = ColHH.Item(MaSoHH(i, 1))
            
            If Err.Number <> 0 Then             ''Truong hop CHUA CO MaHH trong collecttion colHH, nen ta cong vao, va gan gia tri vao arrRes
                On Error GoTo 0
                k = k + 1
                ColHH.Add Item:=k, Key:=MaSoHH(i, 1)
                arrRes(k, 2) = MaSoHH(i, 1)     ''gan gia tri cot 1 cot 2 mang arrRes (la TT va Maso)
                arrRes(k, c1) = tmpSolg ''SoLG(i, 1)
                arrRes(k, c2) = tmpTien ''ThanhTien(i, 1)
            Else                                ''case Err.Number <> 0  ''Truong hop DA CO MaHH trong collecttion,
                On Error GoTo 0
                arrRes(p, c1) = arrRes(p, c1) + tmpSolg ''SoLG(i, 1)
                arrRes(p, c2) = arrRes(p, c2) + tmpTien ''ThanhTien(i, 1)
            End If ''Err.Number <> 0
        End If ''Ngay(i, 1) <= Day2
    Next i ''FOR i
    
    ''tinh toan TON CUOI KY & tinh Tong GrandTotal cua cac cot Thanh tien: TonDK, NHAP, XUAT, & TON CUOI
    ''bang cach duyet cac dong cua arrRes
    p = k + 1
    For i = 1 To k
        arrRes(i, 1) = i
        On Error Resume Next
        arrRes(i, 3) = ColDM.Item(arrRes(i, 2))(0) ''gan gia tri cot 3 cot 4 mang arrRes (la TenHH va Donvi) duoc lay tu  colDM
        arrRes(i, 4) = ColDM.Item(arrRes(i, 2))(1)
        On Error GoTo 0
        
        arrRes(i, 11) = arrRes(i, 5) + arrRes(i, 7) - arrRes(i, 9) ''Tinh ton cuoi ky cot 11 cot 12 cua Ket qua arrRes
        arrRes(i, 12) = arrRes(i, 6) + arrRes(i, 8) - arrRes(i, 10)
        
        arrRes(p, 6) = arrRes(p, 6) + arrRes(i, 6) ''Tinh Tong GrandTotal cua cac cot Thanh tien: TonDK, NHAP, XUAT, & TON CUOI trong arrRes
        arrRes(p, 8) = arrRes(p, 8) + arrRes(i, 8)
        arrRes(p, 10) = arrRes(p, 10) + arrRes(i, 10)
        arrRes(p, 12) = arrRes(p, 12) + arrRes(i, 12)
    Next i
    
  
    ''Xuat ket qua ra Sheet
    With Range("KetQuaNXT").Offset(1)
        .Resize(13, 12).ClearContents
        If k Then .Resize(p, 12) = arrRes
    End With
End Sub

P/S: vì dung lượng các file khá lớn, nên tôi sẽ gỡ bỏ files (code chưa chính xác) ở các bài viết trước nhé, các bạn cần thì cập nhập theo file mới nhất, xin cảm ơn

vodoi2x · 14/2/14

Cũng nhân đây nhờ chủ topic NDT, test code cho 2 trường hợp Collection và Dictionary ở các files trên, thử xem cùng môi trường và cách test chuyên nghiệp - so sánh xem các giải pháp thế nào, xin cám ơn.

Và mọi người cứ xem xét, chắc vẫn còn có thể cải thiện giảm thêm thời gian chạy nữa - nhất là các lần chạy kế (lần chạy 2, 3,...) - ví như 1 cáchnếu chúng ta ghi kết quả trung gian xuống phần tạm phụ nào đó của sheet

Nguyễn Duy Tuân · 14/2/14

vodoi2x đã viết:
Cũng nhân đây nhờ chủ topic NDT, test code cho 2 trường hợp Collection và Dictionary ở các files trên, thử xem cùng môi trường và cách test chuyên nghiệp - so sánh xem các giải pháp thế nào, xin cám ơn.

Và mọi người cứ xem xét, chắc vẫn còn có thể cải thiện giảm thêm thời gian chạy nữa - nhất là các lần chạy kế (lần chạy 2, 3,...) - ví như 1 cáchnếu chúng ta ghi kết quả trung gian xuống phần tạm phụ nào đó của sheet

Vâng. Sau 14h ngày mai em sẽ upload các file của các tác giả để tất cả mọi người tham khảo, so sánh. Em sẽ test các file của anh và mọi người sau đó sẽ thông báo kết quả. Từ kết quả test lần này tất cả chúng ta cùng trao đôi thêm về các vấn đề tốc độ, tính học thuật, kỹ thuật VBA.

Trong các file đã nhận vẫn chưa ai làm bằng ADO với SQL có lẽ lý do tốc độ không bằng phương pháp khác. Tuy nhiên SQL là giải pháp tổng thể và linh hoạt trong trích lọc dữ liệu. Vậy nhờ anh Hai Lúa Miền Tây làm giúp bằng ADO để chúng ta có đầy đủ hơn các giải pháp của dạng bài toán liên quan đến CSDL, dù tốc độ có thể không nhanh bằng các dạng khác ở ví dụ này.

vodoi2x · 14/2/14

Nguyễn Duy Tuân đã viết:
........
Trong các file đã nhận vẫn chưa ai làm bằng ADO với SQL có lẽ lý do tốc độ không bằng phương pháp khác. Tuy nhiên SQL là giải pháp tổng thể và linh hoạt trong trích lọc dữ liệu. Vậy nhờ anh Hai Lúa Miền Tây làm giúp bằng ADO để chúng ta có đầy đủ hơn các giải pháp của dạng bài toán liên quan đến CSDL, dù tốc độ có thể không nhanh bằng các dạng khác ở ví dụ này.

Đúng thế nhắc đến dữ liệu dạng cơ sở dữ liệu như bài này, thì SQL vẫn là đa năng và uyển chuyển nhất, tiếc là nếu cứ xét tốc độ SQL áp vào Excel là ngoại tác vụ nên có thể kém hơn chút, nhưng cũng nên xem xét thì sẽ có nhiều cái hay để bàn

ptm0412 · 14/2/14

Tôi thấy code vodoi2x cực kỳ nhanh, chưa kiểm tra kỹ, chỉ vừa kiểm tra kết quả tính toán, thì thấy có sót số liệu 1 dòng cuối:

Mã:

With Range("KHO").Resize(Range("KHO").Rows.Count - 1, 1).[COLOR=#ff0000]Offset(, 1)[/COLOR]

Chắc là do sai sót khi gõ thôi, chứ code thì tuyệt rồi.

[THI] Tạo sổ TH NXT với tốc độ nhanh nhất, dữ liệu 65,532 dòng

Nghị Hách

File đính kèm

Nothing & Nothing

Nguyễn Khắc Duy

Nothing & Nothing

Nothing & Nothing

Chuyên gia GPE

Thành viên gắn bó

Chuyên gia GPE

Thành viên gắn bó

Chuyên gia GPE

Nothing & Nothing

❆❆❆❆❆❆❆❆

Chuyên gia GPE

Cạo lấy gì gội (Dịch quá không gội được)

Cạo lấy gì gội (Dịch quá không gội được)

❆❆❆❆❆❆❆❆

Nothing & Nothing

File đính kèm

Nothing & Nothing

Nghị Hách

Nothing & Nothing

Bad Excel Member

Facebook

Group