[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]

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.
-----------------

 

[Nguyễn Duy Tuân]

Cảm ơn anh Nguyễn Duy Tuân đã tạo một topic hay để chúng em được học các phương án hay từ các thành viên GPE và dhn46 cũng cảm ơn các anh chị đã nhiệt tình tham gia cho em được mở mang thêm kiến thức.

Với những thành viên "mới tiếp cận VBA" em cũng đề xuất chú ý thêm phần đặt biến tạm, bởi nếu tận dụng nó thì tốc độ cũng tăng thêm một chút như bài #138 em đã nói đến.

Nhờ anh Nguyễn Duy Tuân Test hộ em Code sau khi dùng biến tạm để có thể so sánh với việc không dùng biến tạm tại bài #175.
Qua bài #139 của anh Vodoi2x em cũng đã test và thấy nếu dùng .Value2 gán cho mảng thì tốc độ cũng được cải thiện, đây là một cái mới với em mà quan topic này em đã may mắn được biết.

(Code sử dụng biến tạm - chưa áp dụng .Value2 để gán mảng)

Sub LapSo()
'Tat update man hinh, tu dong tinh toan
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    'Khai bao bien
    Dim ArrData, ArrDM, Res
    Dim iR  As Long
    Dim jC  As Long
    Dim k   As Long
    Dim p   As Long
    Dim Code As String
    Dim FDate As Date
    Dim TDate As Date
    Dim DicDM As Object
    Dim DicData As Object
    'Khoi tao Dictionary
    Set DicDM = CreateObject("Scripting.Dictionary")
    Set DicData = CreateObject("Scripting.Dictionary")


    'Gan gia tri vao mang
    ArrData = Sheets("KHO").[A4].Resize(Sheets("KHO").[A4].End(xlDown).Row - 3, 11)
    ArrDM = Sheets("DM VLSPHH").[A4].Resize(Sheets("DM VLSPHH").[A4].End(xlDown).Row - 3, 4)
    ReDim Res(1 To UBound(ArrDM, 1) + 1, 1 To 12)
    FDate = Sheets("SETTING").[B1].Value2    'Tu ngay
    TDate = Sheets("SETTING").[B2].Value2    'Den ngay
    'Dua du lieu vao DicDM (danh muc hang hoa)
    For iR = 1 To UBound(ArrDM, 1)
        If Not DicDM.Exists(ArrDM(iR, 1)) Then
            k = k + 1
            DicDM.Add ArrDM(iR, 1), k
        End If
    Next
    k = 0
    'Duyet 1 vong qua Data
    For iR = 1 To UBound(ArrData, 1)
        Code = ArrData(iR, 7)
        If ArrData(iR, 2) <= TDate Then
            If Not DicData.Exists(Code) Then
                k = k + 1
                DicData.Add Code, k
                Res(k, 1) = k
                Res(k, 2) = Code
                Res(k, 3) = ArrDM(DicDM.Item(Code), 2)
                Res(k, 4) = ArrDM(DicDM.Item(Code), 3)
                'Khoi tao gia tri
                If ArrData(iR, 2) < FDate Then        'Ton
                    Res(k, 5) = ArrData(iR, 8)
                    Res(k, 6) = ArrData(iR, 11)
                Else        'Trong ky
                    p = DicData.Item(Code)
                    If ArrData(iR, 10) = "N" Then        'Nhap
                        Res(p, 7) = ArrData(iR, 8)
                        Res(p, 8) = ArrData(iR, 11)
                    Else        'Xuat
                        Res(p, 9) = ArrData(iR, 8)
                        Res(p, 10) = ArrData(iR, 11)
                    End If
                End If
            Else        'Truy xuat cac gia tri da co
                p = DicData.Item(Code)
                If ArrData(iR, 2) < FDate Then        'Ton
                    Res(p, 5) = Res(p, 5) + ArrData(iR, 8)
                    Res(p, 6) = Res(p, 6) + ArrData(iR, 11)
                Else        'Trong ky
                    If ArrData(iR, 10) = "N" Then        'Nhap
                        Res(p, 7) = Res(p, 7) + ArrData(iR, 8)
                        Res(p, 8) = Res(p, 8) + ArrData(iR, 11)
                    Else        'Xuat
                        Res(p, 9) = Res(p, 9) + ArrData(iR, 8)
                        Res(p, 10) = Res(p, 10) + ArrData(iR, 11)
                    End If
                End If
            End If
        End If
    Next
    'Tinh ton cuoi va cac gia tri tong cong
    For jC = 5 To 10
        For iR = 1 To k
            If jC / 2 = Int(jC / 2) Then
                Res(k + 1, jC) = Res(k + 1, jC) + Res(iR, jC)
            End If
            Res(iR, 11) = Res(iR, 5) + Res(iR, 7) - Res(iR, 9)
            Res(iR, 12) = Res(iR, 6) + Res(iR, 8) - Res(iR, 10)
        Next
    Next
    Res(k + 1, 12) = Res(k + 1, 6) + Res(k + 1, 8) - Res(k + 1, 10)
    Res(k + 1, 3) = "C" & ChrW(7897) & "ng:"
    'Gan du lieu xuong Sheet
    Sheets("THNXT").Range("B12:B65535").EntireRow.Delete
    If k Then
        Sheets("THNXT").Range("B12").Resize(k + 1, 12) = Res
        Set DicDM = Nothing
        Set DicData = Nothing
        'Dinh dang
        With Sheets("THNXT")
            .Range("B10").CurrentRegion.NumberFormat = "#,##0"
            .Range("B10").CurrentRegion.Font.Size = 12
            .Range("B" & k + 12 & ":M" & k + 12).Font.Bold = True
            .Range("B" & 12 & ":M" & k + 11).Borders.LineStyle = xlContinuous
            .Range("B" & 12 & ":M" & k + 11).Borders(xlInsideHorizontal).LineStyle = xlDash
            .Range("B" & k + 12 & ":M" & k + 12).Borders.LineStyle = xlContinuous
        End With
    End If
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Đã test code của bạn ở trên. Tốc độ đạt 667, nhanh hơn code cũ là ~200 mili giây. Có lẽ cần tiếp tục xử lý mảng nữa để đạt tốc độ nhanh hơn.

 

[Nguyễn Duy Tuân]

Khi thực hiện trên CSDL, nếu không kiểm tra trước sẽ luôn luôn phát sinh lỗi về dữ liệu.

(1) Dữ liệu không có ở sheet KHO --> LỖI (nếu không bẫy lỗi này thì luôn luôn xảy ra lỗi nếu dùng mảng)

(2) Dữ liệu chỉ 1 hàng duy nhất --> LỖI

Với mục (2) tại sao lỗi? Bởi vì khi thực hiện với mảng 1 cột, thì dữ liệu chỉ có 1 cell thì chưa tạo thành mảng nên phát sinh ra lỗi. Vì vậy, những ai mới sử dụng kiểu này thì phải bẫy lỗi này bằng cách:

a) Xét 1 mảng xem có phải là mảng chưa rồi tính chuyện nếu chưa phải thì làm thế nào.

b) Không cần xét mà phải thêm 1 hàng vào nữa, nhưng chú ý tới vấn đề "cạn dòng" (tức sheet có bao nhiêu hàng và dữ liệu cũng đã có nhiêu đó hàng - hiếm nhưng cũng có khả năng phát sinh). Vì thế khi bẫy lỗi trong vòng lặp phải loại trừ dòng rỗng (cách này coi bộ không ổn vì phải loại trừ nhiều lần trong vòng lặp). Như trường hơp của Vodoi2x vì đã thêm 1 dòng rỗng, nhưng do không bẫy lỗi khi gán vào biểu mẫu thay vì chỉ 1 mã hàng được chọn thì sẽ có 2 mã hàng, trong đó có 1 mã là rỗng.

Ý kiến anh Nghĩa rất đúng. Khi đưa code này vào thực tế thì cần kiểm tra hợp thức hóa của mảng nếu không sẽ lỗi. Range.Value(2) nếu từ 2 ô trử lên sẽ là mảng 2D, nếu chỉ 1 ô thì nó không phải là mảng. Hướng giải quyết như anh Nghĩa đưa ra hoặc có thể cải tiến CSDL như sau:
Sổ KHO, Ngay sau dòng tiêu đề ta đưa dòng giá trị trống. Cách này rất cần thiết nếu sử dụng ADO:
Kiểu ngày tháng, số là 0; Kiểu văn bản là ';
Từ dòng thứ 2 mới là dòng dữ liệu của doanh nghiệp.

Vậy trong code ta vẫn làm bình thường để kiểm tra có dữ liệu hay không ta dùng
If not IsArray(Mảng dữ liệu) then
'Không có dữ liệu
'Làm những việc không dữ liệu
'Thoát...
End If

 

[Hoàng Trọng Nghĩa]

Em hỏi anh Tuân nha, với cách Add như thế này:

    ListArr = Sheet1.Range("A4:C" & ListEndR).Value2
    ListCt = UBound(ListArr, 1)
    ''Nap mang danh muc vao Dic
    For i = 1 To ListCt
        Dic1.Add ListArr(i, 1), i
    Next

Nếu như ở chỗ em mỗi bill là một mã hàng, thì một năm cầu cả triệu bill, nếu add kiểu trên liệu có ổn không?

Thực chất khi phát sinh mã nào trong khoảng thời gian nào thì mới lọc theo khoảng thời gian đó chứ nếu add toàn bộ danh mục như thế quá phí phạm dung lượng và thời gian. Thực tế thì đâu chỉ 12 mã hàng như bài test này?

Đó là ở Cảng, không chủ động được vấn đề Bill (tùy thuộc vào chủ hàng nhập về), còn với kho vật tư, chẳng hạn một kho phụ tùng xe, người ta chủ động nhập mã hàng từ các nhà sản xuất xe, mỗi công ty xe có mỗi mã hàng khác nhau (mặc dù cùng chủng loại), đó là việc nhập mã, còn thực tế phát sinh, không phải lúc nào cũng phải nhập tất cả các mặt hàng đó trong năm, nếu phải Add tất cả các mã hàng vào Dict, rồi cuối cùng xử lý loại ra những mã hàng có tất các cột là rỗng thì lại tốn thời gian không? Cho nên khi làm cần phải phân tích và lường trước điều thực tế có thể xảy ra.

Trên sheet được một ưu điểm rất đặc biệt là ta có thể gán mảng "co giản" theo cột hoặc hàng tùy thich nên ta mới có thể thực hiện được điều này theo k:

Sheet26.[B12].Resize([COLOR=#ff0000][B]k[/B][/COLOR], 12) = RArr

Giả sử mảng RArr này gán lên ListBox thì thế nào nhỉ? Rất nhiều dòng trống xảy ra nếu danh mục hàng nhiều hơn 12 mã hàng và thực tế phát sinh trong thời gian đó không tới 12 mã hàng.

Chỉ là hỏi để hiểu thêm thuật toán để áp dụng vào thực tế.

 

[ptm0412]

Ý kiến anh Nghĩa rất đúng. Khi đưa code này vào thực tế thì cần kiểm tra hợp thức hóa của mảng nếu không sẽ lỗi. Range.Value(2) nếu từ 2 ô trử lên sẽ là mảng 2D, nếu chỉ 1 ô thì nó không phải là mảng. Hướng giải quyết như anh Nghĩa đưa ra hoặc có thể cải tiến CSDL như sau:
Sổ KHO, Ngay sau dòng tiêu đề ta đưa dòng giá trị trống. Cách này rất cần thiết nếu sử dụng ADO:
Kiểu ngày tháng, số là 0; Kiểu văn bản là ';
Từ dòng thứ 2 mới là dòng dữ liệu của doanh nghiệp.

Vậy trong code ta vẫn làm bình thường để kiểm tra có dữ liệu hay không ta dùng
If not IsArray(Mảng dữ liệu) then
'Không có dữ liệu
'Làm những việc không dữ liệu
'Thoát...
End If

Tôi không làm như thế. Khi xác định DataEndRow thì kiểm tra EndRow bằng bao nhiêu, nếu = 3 (là dòng tiêu đề) tức là dữ liệu rỗng. Nếu bằng 4 tức là chỉ có 1 dòng dữ liệu. (trong trường hợp này sẽ dùng xlUp thay vì xlDown hoặc tùy biến). Tại sao phải gán năm bảy Array rồi mới kiểm tra năm bảy array đó?
Ngoài ra,với cấu trúc dữ liệu chuẩn, luôn luôn có ít nhất 1 cột không được phép rỗng (ngày chứng từ, số chứng từ, mã hàng, ID dòng, ...), Cột nào rỗng nghĩa là cột đó được phép rỗng. Ta dùng cột chuẩn đó để xác định và không cần kiểm tra ô rỗng, không cần thêm 1 dòng dữ liệu rỗng gì cả.

Nếu như ở chỗ em mỗi bill là một mã hàng, thì một năm cầu cả triệu bill, nếu add kiểu trên liệu có ổn không?

1. Mỗi Bill là 1 mã hàng, thì có ít nhất 1 dòng nhập và/hoặc 1 dòng xuất (đang nói về nhập xuất tồn), số dòng dữ liệu luôn lớn hơn số dòng mã.
2. Nếu danh mục là 1 triệu mã hàng kèm với số dư đầu kỳ (mà thường là thế, tại sao thì tôi nói sau ở mục 4), thì nếu không lấy danh mục làm chuẩn, sẽ bỏ sót những mã có dư đầu kỳ mà không có nhập xuất trong kỳ (mặt hàng chết). Việc này tôi đã nói ở bài trên
3. Thông thường đối với dữ liệu lớn và qua nhiều năm, định kỳ người ta đánh dấu trong danh mục những mã hàng không còn sử dụng. Nên khi nạp danh mục sẽ kiểm tra loại bớt.
4. Nếu quả thực mã hàng 1 triệu dòng (không phải không có), hiếm khi người ta sử dụng Excel. Vì nếu 1 triệu dòng mã sẽ có trên 1 triệu dòng nhập xuất, Excel không chứa hết. Nếu sử dụng Excel người ta cũng tách dữ liệu ra từng năm, mỗi năm có số dư đầu kỳ, và mỗi khi tạo dữ liệu cho năm mới cũng loại bỏ bớt những mã không còn dùng ra khỏi danh mục.
5.Với thí dụ của Nghĩa mỗi bill là 1 mã (không trùng bao giờ), thì người ta sẽ không tạo danh mục làm gì. Sinh ra 1 mã chỉ xài 1 lần thì không tạo danh mục.

 

[Hoàng Trọng Nghĩa]

Tôi không làm như thế. Khi xác định DataEndRow thì kiểm tra EndRow bằng bao nhiêu, nếu = 3 (là dòng tiêu đề) tức là dữ liệu rỗng. Trong trường hợp này sẽ dùng xlUp thay vì xlDown hoặc tùy biến). Tại sao phải gán năm bảy Array rồi mới kiểm tra năm bảy array đó?
Ngoài ra,với cấu trúc dữ liệu chuẩn, luôn luôn có ít nhất 1 cột không được phép rỗng (ngày chứng từ, số chứng từ, mã hàng, ID dòng, ...), Cột nào rỗng nghĩa là cột đó được phép rỗng. Ta dùng cột chuẩn đó để xác định và không cần kiểm tra ô rỗng, không cần thêm 1 dòng dữ liệu rỗng gì cả.

Giờ thực tế đi, Sư phụ thử ngay cái code của Sư phụ đi, trong sheet KHO xóa hết chừa 1 dòng tiêu đề và 1 dòng dữ liệu đi sẽ như thế nào. Đừng có nói là dữ liệu chỉ 1 dòng là không thực tế nha! Một dữ liệu luôn luôn phải có dòng đầu tiên. Nếu không may trong tháng chỉ phát sinh mỗi 1 nghiệp vụ nhập (chưa xuất, chưa tồn gì cả) thì báo cáo tháng có dính chưởng lỗi này hay không!

1. Mỗi Bill là 1 mã hàng, thì có ít nhất 1 dòng nhập và/hoặc 1 dòng xuất (đang nói về nhập xuất tồn), số dòng dữ liệu luôn lớn hơn số dòng mã.
2. Nếu danh mục là 1 triệu mã hàng kèm với số dư đầu kỳ (mà thường là thế, tại sao thì tôi nói sau ở mục 4), thì nếu không lấy danh mục làm chuẩn, sẽ bỏ sót những mã có dư đầu kỳ mà không có nhập xuất trong kỳ (mặt hàng chết). Việc này tôi đã nói ở bài trên
3. Thông thường đối với dữ liệu lớn và qua nhiều năm, định kỳ người ta đánh dấu trong danh mục những mã hàng không còn sử dụng. Nên khi nạp danh mục sẽ kiểm tra loại bớt.
4. Nếu quả thực mã hàng 1 triệu dòng (không phải không có), hiếm khi người ta sử dụng Excel. Vì nếu 1 triệu dòng mã sẽ có trên 1 triệu dòng nhập xuất, Excel không chứa hết. Nếu sử dụng Excel người ta cũng tách dữ liệu ra từng năm, mỗi năm có số dư đầu kỳ, và mỗi khi tạo dữ liệu cho năm mới cũng loại bỏ bớt những mã không còn dùng ra khỏi danh mục.
5.Với thí dụ của Nghĩa mỗi bill là 1 mã (không trùng bao giờ), thì người ta sẽ không tạo danh mục làm gì. Sinh ra 1 mã chỉ xài 1 lần thì không tạo danh mục.

Sư phụ chưa đọc những gì em mới cập nhật ở bài đó. Ở Cảng thì không chủ động nên nhập bao nhiêu tính bấy nhiêu OK.

Nhưng với một kho vật tư thì hoàn toàn khác, họ luôn luôn chủ động nhập mã trước do nhà sản xuất cung cấp, Sư phụ thử hỏi các Đại lý xe máy xem sẽ biết liền (đã từng giúp đỡ cho các đại lý này nên hoàn toàn nắm rõ điều đó).

 

[Hoàng Trọng Nghĩa]

Các bạn thử xem 1 bảng báo giá của một Đại lý xe mà tôi đã từng giúp đỡ. Có 17,800 dòng đấy!

Hãy suy luận thực tế sẽ như thế nào mà định hướng cho code của mình hiệu quả, chỉ vậy thôi.

 

[Nguyễn Duy Tuân]

Tôi làm csdl khá nhiều cả MySQL cả Excel với các bài toán thực tế về kế toán, kho, A-Tools. Những sổ sách phải dùng VBA thuần tuý có nhiều trường hợp phải dùng SQL. Vậy nên CSDL tôi luôn phải làm dòng đầu tiên trống với giá trị giả định theo kiểu dữ liệu của trường trong bảng. Lưu ý là khi bảng dữ liệu trống hoàn toàn hoặc có vài dòng dữ liệu đầu tiên nhưng dữ liệu không xác định kiểu rõ ràng dẫn đến ADO hiểu sai trường dữ liệu dẫn đến lỗi. Các table của loại csdl khác được khai báo kiểu dữ liệu rõ ràng nên không bị lỗi. Còn bảng tính Excel kiểu dữ liệu phụ thuộc vào giá trị nhập vào ở 8 dòng đầu tiên. Vậy nếu không có hoặc có cột nào đó chưa nhập dữ liệu thì ADO hiểu sai cấu trúc là bình thường. Ví thế từ lâu tôi làm trên Excel luôn làm dòng giả định để ADO xác định kiểu giá trị đúng.
Vấn đề về số dư đầu. Có nhiều người nhập số dư đầu trong danh mục tôi cho là không chuẩn vì các lý do sau:
- Một mã hàng hoá, vật tư có thể tồn ở 3 kho, 3 bộ phận. Vậy một dòng danh mục của mã này sẽ nhập thế nào? Mở thêm cột không phải giải pháp tổng thế.
- Tồn đầu được xác định bởi thời điểm. Trong cả kỳ làm việc sẽ có nhiều lần chốt tồn đầu. Vậy danh mục ghi thế nào?
Vậy nên danh mục hãy chỉ để lưu thông tin chi tiết về đối tượng mà thôi.

 

[Lê Duy Thương]

rất cám ơn anh tuân đã mở topic này. nhờ có topic này mà tôi lại biết viết code tạo pivot table đơn giản (1sheet dữ liệu).hy vọng một ngày không xa tôi có thể viết code cho pivot table sử dụng nguồn bằng SQL hoặc ADO (dữ liệu từ nhiều sheets)

Qua topic này tôi lại nắm thêm được dictionary,mảng array,hay collection.

cám ơn sự gợi ý của anh tuân, của sp PTM0412.
cám ơn rất nhiều
THANKS
THƯƠNG

 

[Hoàng Trọng Nghĩa]

Có một sự so sánh thêm vì Anh Tuân mới viết về hàm ItemExists, thử so sánh 3 phương pháp Exists thì thấy các đối tượng vẫn nhanh hơn so với mảng!

Option Explicit
Declare Function QueryPerformanceCounter Lib "Kernel32" _
                        (x As Currency) As Boolean
Declare Function QueryPerformanceFrequency Lib "Kernel32" _
                        (x As Currency) As Boolean


''Cac ham kiem tra:
Function Exists(ByRef Collect As Collection, ByVal sKey As String) As Boolean
    Dim lCheck As Long
    On Error Resume Next
    lCheck = VarType(Collect.Item(sKey))
    If Err.Number = 0 Then
        Exists = True
    Else
        Exists = False
    End If
End Function


Function ItemExists(Item, Arr()) As Long
    Dim i&
    ItemExists = -1
    On Error GoTo lbDone
    If Not IsArray(Arr) Then Exit Function
    'Tim tu phan tu cuoi cung cua mang len dau se dat toc do tim nhanh neu du lieu nguon duoc sap xep tang dan
    For i = UBound(Arr) To LBound(Arr) Step -1
        If Arr(i) = Item Then
            ItemExists = i
            Exit For
        End If
    Next i
lbDone:
'Loi xay ra neu
End Function


Sub DoThoiGian()
    Dim T1@, T2@, Freq@, Overhead@
    QueryPerformanceFrequency Freq
    QueryPerformanceCounter T1
    QueryPerformanceCounter T2
    Overhead = T2 - T1
    QueryPerformanceCounter T1
    
    ''Tot nhat cho du lieu tu duoi 200 ngan dong:
    DictTest
    
    ''Tu tren 200 ngan dong tro len:
    'CollTest
    
    'Chi 10 ngan dong da thay qua cham:
    'ArrTest
    
    QueryPerformanceCounter T2
    Debug.Print (T2 - T1 - Overhead) / Freq * 1000; "milliseconds(ms)"
End Sub


''Test cac thu tuc:
''----------------------------------------------------
Sub DictTest()
    Dim i As Long
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
    For i = 1 To [COLOR=#0000ff]200000[/COLOR]
        If Not Dict.Exists("Nghia" & i) Then
            Dict.Add "Nghia" & i, i
        End If
    Next
End Sub


Sub CollTest()
    Dim i As Long
    Dim Collect As New Collection
    For i = 1 To [COLOR=#0000ff]200000[/COLOR]
        If Not Exists(Collect, "Nghia" & i) Then
            Collect.Add i, "Nghia" & i
        End If
    Next
End Sub


Sub ArrTest()
    Dim i As Long
    Dim Arr(1 To [COLOR=#ff0000]10000[/COLOR])
    For i = 1 To [COLOR=#ff0000]10000[/COLOR]
        If ItemExists("Nghia" & i, Arr) = 0 Then
            Arr(i) = "Nghia" & i
        End If
    Next
End Sub

Các anh thử copy về một module nào đó và chạy thử xem.

 

[Nguyễn Duy Tuân]

Có một sự so sánh thêm vì Anh Tuân mới viết về hàm ItemExists, thử so sánh 3 phương pháp Exists thì thấy các đối tượng vẫn nhanh hơn so với mảng!

Option Explicit
Declare Function QueryPerformanceCounter Lib "Kernel32" _
                        (x As Currency) As Boolean
Declare Function QueryPerformanceFrequency Lib "Kernel32" _
                        (x As Currency) As Boolean


''Cac ham kiem tra:
Function Exists(ByRef Collect As Collection, ByVal sKey As String) As Boolean
    Dim lCheck As Long
    On Error Resume Next
    lCheck = VarType(Collect.Item(sKey))
    If Err.Number = 0 Then
        Exists = True
    Else
        Exists = False
    End If
End Function


Function ItemExists(Item, Arr()) As Long
    Dim i&
    ItemExists = -1
    On Error GoTo lbDone
    If Not IsArray(Arr) Then Exit Function
    'Tim tu phan tu cuoi cung cua mang len dau se dat toc do tim nhanh neu du lieu nguon duoc sap xep tang dan
    For i = UBound(Arr) To LBound(Arr) Step -1
        If Arr(i) = Item Then
            ItemExists = i
            Exit For
        End If
    Next i
lbDone:
'Loi xay ra neu
End Function


Sub DoThoiGian()
    Dim T1@, T2@, Freq@, Overhead@
    QueryPerformanceFrequency Freq
    QueryPerformanceCounter T1
    QueryPerformanceCounter T2
    Overhead = T2 - T1
    QueryPerformanceCounter T1
    
    ''Tot nhat cho du lieu tu duoi 200 ngan dong:
    DictTest
    
    ''Tu tren 200 ngan dong tro len:
    'CollTest
    
    'Chi 10 ngan dong da thay qua cham:
    'ArrTest
    
    QueryPerformanceCounter T2
    Debug.Print (T2 - T1 - Overhead) / Freq * 1000; "milliseconds(ms)"
End Sub


''Test cac thu tuc:
''----------------------------------------------------
Sub DictTest()
    Dim i As Long
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
    For i = 1 To [COLOR=#0000ff]200000[/COLOR]
        If Not Dict.Exists("Nghia" & i) Then
            Dict.Add "Nghia" & i, i
        End If
    Next
End Sub


Sub CollTest()
    Dim i As Long
    Dim Collect As New Collection
    For i = 1 To [COLOR=#0000ff]200000[/COLOR]
        If Not Exists(Collect, "Nghia" & i) Then
            Collect.Add i, "Nghia" & i
        End If
    Next
End Sub


Sub ArrTest()
    Dim i As Long
    Dim Arr(1 To [COLOR=#ff0000]10000[/COLOR])
    For i = 1 To [COLOR=#ff0000]10000[/COLOR]
        If ItemExists("Nghia" & i, Arr) = 0 Then
            Arr(i) = "Nghia" & i
        End If
    Next
End Sub

Các anh thử copy về một module nào đó và chạy thử xem.

Anh Nghĩa test code so sánh array và collection của mình ở bài trên chưa? Tình huống khá giống thực tế của topic này.
Nhà đang mất điện nên chưa test được . Bài test của a Nghĩa với giả thiết không tìm được giá trị trong mảng vì giá trị của nó luôn mới. Vậy hàm tìm kiến ItemExists luông phải chạy đủ số vòng lặp. Nên chậm. Nếu anh nghĩa tìm giá trị "Nghĩa " & i-1 có thể sẽ nhanh. Hàm ItemExists phát huy tốc độ khi phải tìm giá trị thực sự tồn tại teong danh sách tìm, nếu dữ liệu nguồn được sắp xếp thì càng nhanh.

 

[Hoàng Trọng Nghĩa]

Anh Nghĩa test code so sánh array và collection của mình ở bài trên chưa? Tình huống khá giống thực tế của topic này.
Nhà đang mất điện nên chưa test được . Bài test của a Nghĩa với giả thiết không tìm được giá trị trong mảng vì giá trị của nó luôn mới. Vậy hàm tìm kiến ItemExists luông phải chạy đủ số vòng lặp. Nên chậm. Nếu anh nghĩa tìm giá trị "Nghĩa " & i-1 có thể sẽ nhanh. Hàm ItemExists phát huy tốc độ khi phải tìm giá trị thực sự tồn tại teong danh sách tìm, nếu dữ liệu nguồn được sắp xếp thì càng nhanh.

A, a, aaaa, phải test thế này mới công bằng!

Chạy sub GetData trước rồi mới DoThoiGian!

Option Explicit
Declare Function QueryPerformanceCounter Lib "Kernel32" _
                        (x As Currency) As Boolean
Declare Function QueryPerformanceFrequency Lib "Kernel32" _
                        (x As Currency) As Boolean


Private Dict As Object, Collect As New Collection, Arr(), Check As Boolean


''Test cac thu tuc:
''----------------------------------------------------
Sub GetData()
    ''chay mot lan duy nhat!
    Set Dict = Nothing
    Set Collect = Nothing
    Erase Arr
    
    Dim i As Long
    Set Dict = CreateObject("Scripting.Dictionary")
    ReDim Arr(1 To 200000)
    For i = 1 To 200000
        Dict.Add "Nghia" & i, i
        Collect.Add i, "Nghia" & i
        Arr(i) = "Nghia" & i
    Next
End Sub


Sub DictTest()
    Check = Dict.Exists("Nghia" & 2000001)
End Sub


Sub CollTest()
    Check = Exists(Collect, "Nghia" & 2000001)
End Sub


Sub ArrTest()
    Check = Not (ItemExists("Nghia" & 2000001, Arr) = 0)
End Sub


''Cac ham kiem tra:
Function Exists(ByRef Collect As Collection, ByVal sKey As String) As Boolean
    Dim lCheck As Long
    On Error Resume Next
    lCheck = VarType(Collect.Item(sKey))
    If Err.Number = 0 Then
        Exists = True
    Else
        Exists = False
    End If
End Function


Function ItemExists(Item, Arr()) As Long
    Dim i&
    ItemExists = -1
    On Error GoTo lbDone
    If Not IsArray(Arr) Then Exit Function
    'Tim tu phan tu cuoi cung cua mang len dau se dat toc do tim nhanh neu du lieu nguon duoc sap xep tang dan
    For i = UBound(Arr) To LBound(Arr) Step -1
        If Arr(i) = Item Then
            ItemExists = i
            Exit For
        End If
    Next i
lbDone:
'Loi xay ra neu
End Function


Sub DoThoiGian()
    Dim T1@, T2@, Freq@, Overhead@
    QueryPerformanceFrequency Freq
    QueryPerformanceCounter T1
    QueryPerformanceCounter T2
    Overhead = T2 - T1
    QueryPerformanceCounter T1
    
    ''Tot nhat cho du lieu tu duoi 200 ngan dong:
    'DictTest
    
    ''Tu tren 200 ngan dong tro len:
    'CollTest
    
    'thay doi:
    ArrTest
    
    QueryPerformanceCounter T2
    Debug.Print (T2 - T1 - Overhead) / [COLOR=#ff0000][B]Freq * 1000000[/B][/COLOR]; "milliseconds(ms) " & Check
End Sub

Vẫn cảm thấy dùng mảng vẫn còn chậm trong nhiều trường hợp, kể cả khi đk "Nghia200000"

 

[ptm0412]

Giả sử mảng RArr này gán lên ListBox thì thế nào nhỉ? Rất nhiều dòng trống xảy ra nếu danh mục hàng nhiều hơn 12 mã hàng và thực tế phát sinh trong thời gian đó không tới 12 mã hàng.

Sao lại edit bài thêm hẳn 1 ý như thế? Thêm ý thì phải viết bài mới chứ? Chỉ khi sửa chính tả, sửa sai con số, ... thì mới edit bài.
RArray của tôi làm sao mà có dòng trống được chứ? Chỉ có dòng không dùng đến mà thôi. Còn nếu DMArray lấy từ dữ liệu nhập xuất hàng ngày nó ngắn hơn thật, nhưng gắn vào listbox để làm gì? Gắn vào listbox hoặc combobox là để chọn mã hàng khi nhập liệu chứ dữ liệu nhập xong xuôi gắn vào làm chi.

Về đại lý xe máy thì làm sao bằng siêu thị bán lẻ được. Vấn đề là mã càng nhiều thì giao dịch càng nhiều. Có giao dịch mới tạo mã. Không ai tạo mã ra để đó không dùng cả. Cái thí dụ về xe máy của Nghĩa, tức là như thế: các hãng xe cung cấp cho 10.000 mã, lập tức điền vào danh mục 10.000 dòng. Thực tế là kế toán không làm chuyện thừa đó, họ chỉ thêm mã khi có lô hàng thực sự nhập về và chỉ thêm mã cho mặt hàng đã nhập nhưng chưa có mã mà thôi.
Qua năm mới, bỏ bớt danh mục mặt hàng lỗi mốt, không bán được, không muốn kinh doanh, ...

Nghĩa vẫn chưa đọc kỹ câu hỏi của tôi về tồn đầu. Tuân thì biết vấn đề tồn đầu nên có lẽ cũng lấy từ danh mục.
Dữ liệu đầu năm chỉ mới có năm ba dòng thì đúng, nhưng những mặt hàng tồn chưa kịp bán không hiện lên báo cáo sao?

Tôi cũng bổ sung thêm 1 câu bị bỏ sót là kiểm tra nếu EndRow = 4 tức là dữ liệu 1 dòng, thì xử lý khác cho khỏi lỗi Array, chứ không add năm bảy array rồi kiểm tra năm bảy array đó.

Gởi Tuân,
Ý tôi là không phải nhất thiết lưu trữ tồn đầu trong danh mục, mà lưu trữ trong 1 bảng tồn đầu, bảng này và bảng danh mục có quan hệ 1-1. Nhiều kho thì sẽ có nhiều cột tồn hoặc nhiều bảng tồn như thế. Nhưng đó là dữ liệu lớn và phải xử lý bằng ADO hoặc SQL, không phải trên Excel. Trên Excel thì thêm 1 cột hay vài cột cũng không thành vấn đề.

Mỗi lần tính toán đều có tồn đầu riêng của lần đó, tất nhiên, nhưng vẫn có cái tồn đầu năm tài chính mang sang từ năm trước, và đã kiểm kê cuối năm, so khớp và điều chỉnh. Những cái tồn đầu tháng 2, đầu tháng 8, tồn đầu 15 tháng 4 vẫn phải tính và tính từ đâu? Chả lẽ tính từ lúc mới thành lập công ty tới nay dù cho 5 năm, 10 năm, dữ liệu 1 triệu, chục triệu dòng?

 

[Hoàng Trọng Nghĩa]

Như vầy nha các Thầy, các trường hợp người ta phải nhập danh mục trước rồi mới nhập thực tế sau:

1) Một doanh nghiệp hoạch định, năm nay làm 10 mặt hàng, mỗi mặt hàng là 10 mã hàng. Thế là người ta phải nhập danh mục 10 mã hàng trước. Còn việc nhập liệu sau này lấy danh sách của danh mục này nhập lên combobox hoặc listbox rồi nhập ngược lại thực tế sản xuất.

2) Một tiệm thuốc Tây được chào hàng 1 lô hàng có hàng trăm loại thuốc, thay vì phải nhập thủ công từng mã một, người ta copy danh mục đó vào danh mục của mình, sau đó khi sử dụng trên form người ta nhập loại nào thì xổ ra trên listbox hay combobox loại thực nhập thôi, không lẽ lại gõ thủ công từng mã một, chắc gõ đúng? Rồi còn tên gọi, đơn giá, đơn vị tính v.v...

Việc nhập danh mục trước rồi thực tế sau là chuyện phải làm, chứ không phải đợi làm tới đâu nhập tới đó kiểu lý thuyết suông, áp dụng thực tế thì mất thời gian.

Khi nào người ta bỏ hẳn danh mục nào đó người ta mới xóa dữ liệu đó đi khi dọn dẹp dữ liệu mà thôi, còn không, nó vẫn cứ tồn tại.

 

[ptm0412]

Nghĩa trả lời cho tôi câu hỏi mà tôi nhắc lại 3 lần rồi:

Nghĩa đang lấy danh mục hàng duy nhất từ bảng dữ liệu, chứ không lấy từ bảng danh mục (và không lấy từ danh mục tồn). vậy:

Dữ liệu đầu năm chỉ mới có năm ba dòng thì đúng, nhưng những mặt hàng tồn chưa kịp bán không hiện lên báo cáo sao?

Còn tôi sẽ lấy số tồn trong danh mục luôn. Tuân có thể phản đối, vì Tuân sẽ lưu số tồn ở chỗ khác, còn Nghĩa thì không biết khái niệm có tồn đầu khác zero.

Một câu mà tôi cũng muốn nhắc lại: Kế toán không làm công việc thừa là nhập sẵn 10.000 dòng mã hàng do nhà cung cấp giao cho kiểu giao catalogue. Copy thì copy lúc nào chẳng được, đâu phải 10.000 dòng thì copy, còn 5 dòng thì gõ tay cho sai?

Cái đó không phải lý thuyết suông, mà là thực tế kế toán không làm chuyện thừa.

 

[Hoàng Trọng Nghĩa]

Nghĩa trả lời cho tôi câu hỏi mà tôi nhắc lại 3 lần rồi:

Nghĩa đang lấy danh mục hàng duy nhất từ bảng dữ liệu, chứ không lấy từ bảng danh mục (và không lấy từ danh mục tồn). vậy:

Dữ liệu đầu năm chỉ mới có năm ba dòng thì đúng, nhưng những mặt hàng tồn chưa kịp bán không hiện lên báo cáo sao?

Còn tôi sẽ lấy số tồn trong danh mục luôn. Tuân có thể phản đối, vì Tuân sẽ lưu số tồn ở chỗ khác, còn Nghĩa thì không biết khái niệm có tồn đầu khác zero.

Một câu mà tôi cũng muốn nhắc lại: Kế toán không làm công việc thừa là nhập sẵn 10.000 dòng mã hàng do nhà cung cấp giao cho kiểu giao catalogue. Copy thì copy lúc nào chẳng được, đâu phải 10.000 dòng thì copy, còn 5 dòng thì gõ tay cho sai?

Cái đó không phải lý thuyết suông, mà là thực tế kế toán không làm chuyện thừa.

Không biết các công ty khác thì sao chứ tôi thấy nhiều cty chuyện xuất nhập tồn là chuyện của KHO sau đó mới báo cáo lên cho phòng kế toán xử lý, chẳng lẽ phòng Kho Vận và Kế Toán chung luôn hả ta?

Mà thôi, tùy theo công ty, tùy theo công việc cụ thể mà người thực hiện cân nhắc theo phương án nào là tối ưu nhất. Các ý kiến của tôi chỉ nhằm vào các trường hợp hoặc là bị lỗi, hoặc là tôi cảm thấy thừa mà thôi.

Hy vọng anh Tuân có nhiều đề tài để mọi người cùng tham gia, thảo luận để có thêm nhiều kiến thức cho anh em cùng tham khảo.

Qua bài này học được 2 vấn đề, thứ nhất là Collection, thứ 2 dùng mảng vẫn có thể test Exists nhanh chóng của Anh Tuân.

Cám ơn vì tất cả!

 

[DMQ]

Chào các AC, em theo dõi Topic này từ đầu tới bây giờ.Em đang làm trong kho vật tư xây dựng,em chỉ quản lý về số lượng thôi. Em là tổ trưởng và có 3 nhân viên, mỗi người quản lý về 1 mảng,cập nhật bằng tay trên thẻ kho. Cuối mỗi tháng, 3 nhân viên bào cáo bằng giấy về cho em, và em phải tổng hợp lại bằng giấy để báo cáo kế toán. Em thì không rành về VBA lắm, nhưng thấy các AC cao thủ VBA trong Topic này thi code để chạy nhanh thật đáng nể phục. Bây giờ cuộc thi kết thúc rồi em mới dám hỏi(sợ các AC la rầy), vậy các AC có thể chỉnh lại cho em bài của Bác Tuân như vầy được không ah!!!:
1/bỏ code chạy đo thời gian
2/bỏ code tính thành tiền(ví em chỉ quản lý số lượng còn thành tiền là của kế toán)
3/có thể báo cáo từ ngày đến ngày theo ý của mình(Ví dụ như báo cáo theo tuần hoặc theo tháng).
Em mong được sự giúp đỡ của các AC. Nếu có gì mong các AC bỏ qua cho!!!

 

[Lê Duy Thương]

về pivot table, tôi không đồng ý về việc tăng dung lượng. Nó chỉ lưu trữ dưới dạng số, không hề có công thức và cũng không tính toán lại thường xuyên. Tôi có xem bài của duy thương, refresh (tức là tính toán lại) cũng khoảng 400ms, cộng với code copy ăn gian 50 ms, cũng thuộc loại có hạng. ăn gian như vậy không đúng, vì không phải cứ ngày bắt đầu đó, ngày kết thúc đó mà tính mãi. Phải thay đổi xem báo cáo tháng này, báo cáo tháng kia, báo cáo quý, báo cáo năm, chứ không chỉ xem mãi 1 báo cáo, hoặc có 1 báo cáo tính đi tính lại mãi. Do đó phải tính thêm thời gian refresh.

chỉ có điều thương làm chưa đến nơi đến chốn, vì chưa lường trước 1 số việc:
- giả sử để tính đầu kỳ có cả cộng nhập và trừ xuất, thì đầu kỳ sai
- giả sử trong kỳ chỉ có nhập không có xuất, hoặc có xuất không nhập, hoặc không có cả 2, thì code copy sẽ copy sai.

Thực ra giả thuyết của sư phụ cũng rất đơn giản
Thì chỉ cần sửa lại 1 chut là xong
thầy thử test file xem có còn sai chỗ nào không giúp em.
thông thường em vẫn dùng pivot table để lấy kết quả sau đó copy vào mẫu báo cáo là xong
sếp chỉ cần xem kết quả khi in ra va ký duyệt.
Không biết có phải lê duy thương nghiện pivot table hay không mà khi gặp những dữ liệu lớn thường nghĩ ngay đến pivot table.sau đó mới đến công cụ khác.

 

[siwtom]

Khi đọc đề bài tôi đã có vài chỗ không hiểu nhưng do mọi người đang thi tôi không muốn hỏi vào vì không muốn mọi người mất tập trung.

Tôi không biết người ta ghi sổ sách như thế nào nhưng có vài điểm tôi không hiểu được.

Trích bài #22

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ị...

Ví dụ: Nhìn vào hình trên ta tính cho HH001 với khoảng thời gian từ NGAY1(02/08/2005) đến NGAY2

(31/08/2005)
+ Lượng Tồn đầu. Tra trên dòng những ngày < 02/08/2005 với mặt hàng HH001 ta có
Nhập=4
Xuất=3
Lượng Tồn đầu = 4-3 = 1
+ Lượng Nhập, Xuất trong kỳ. Tra trên dòng có ngày trong khoảng [02/08/2005-31/08/2005] với mặt

hàng HH001 ta có
Nhập=2+4=6
Xuất=3

+ Lượng tồn cuối = 1 + 6 - 3 = 4

1. Tồn đầu. Vẫn biết là Tuân đã cho khái niệm: Mọi Nhập (N) trước ngày 1 cộng với nhau, mọi Xuất (X) cũng cộng với nhau, và hiệu N - X sẽ là tồn đầu.
Theo tôi có vẻ phi thực tế. Vì nếu thế, theo vd. ta thấy ngày 31-07-2005 trong kho không có mặt hàng HH001. Tươnbg tự với các mặt hàng khác. Tức ở thời điểm ngày 31-07-2005 thì kho trống rỗng. Thực tế thì làm gì có kho nào như thế.
Theo cái lôgíc của tôi thì: Nếu tôi làm báo cáo cho khoảng NGAY1 - NGAY2 thì cũng có nghĩa là tôi phải biết được ở thời điểm (NGAY1 - 1) thì trong kho mỗi mặt hàng có bao nhiêu. Giả sử có k mặt hàng trong kho với số lượng là n1, n2, ..., nk thì theo tôi ta sẽ phải tạo vùng dữ liệu kho mà k dòng đầu có ở cột F (tồn đầu) các giá trị n1, n2, ..., nk, tiếp theo là những dòng nhập - tồn trong khoảng NGAY1 - NGAY2.
Nói cách khác ta coi lượng hàng hóa trong kho ở ngày (NGAY1 - 1) là lượng đầu kỳ cho khoảng báo cáo (NGAY1 - NGAY2), tức ta coi n1, n2, ..., nk là lượng hàng hóa mà ta "nhập" từ "kho cũ" sang "kho mới". Và mỗi dòng trong k dòng kể trên có trong cột J ký tự N. Làm gì có chuyện vừa xuất vừa nhập? Ngày 31-07-2005 có bao nhiêu thì ta Nhập (N) vào "kho mới" (trong tưởng tượng thôi) cho báo cáo mới. Thế thôi.

2. Tôi đọc thấy những câu như "mã phát sinh", hay đọc thấy là phải kiểm tra với từng dòng xem nó có thỏa NGAY1 <= ngày <= NGAY2 hay không. Tôi đọc mà không hiểu. Vì theo tôi đã là sổ sách thì có lẽ những mục ghi trong đó là theo thứ tự thời gian. Không có chuyện dòng 100 ứng với ngày 31-07-2005. Cũng không có chuyện ở dòng 100 có ngày 03-09-2005, dòng 102 có ngày 09-09-2005, còn dòng 101 có ngày 01-01-2007 được. Nói cách khác thì nếu tôi hiểu thì các dòng Nhập - Xuất được ghi theo thứ tư thời gian (Làm gì có chuyện thủ kho ngày 08-09-2005 đi làm và ở chỗ làm ghi vào sổ: Ngày 01-01-2007 nhập Honda 5 xe ...). Và nếu thế thì chỉ cần đi từ dòng đầu cho tới ngày >= NGAY1 thì tính những dòng < NGAY1 ta có tồn đầu. Đồng thời có "dòng đầu" của kỳ báo cáo. Đi từ dòng cuối cùng đi lên loại tất cả các dòng trống (nếu có) và các dòng có ngày > NGAY2 ta sẽ có được "dòng cuối". Lúc này thì ta có thể không theo qui tắc

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

Tức ta sẽ không để ý tới cột B nữa mà Nhập - Xuất ta sẽ xác định dựa vào cột J (N - X)

3. Theo tôi sổ sách được ghi theo trình tự thời gian, và theo trình tự các mã xuất hiện và mất đi. Ví dụ ngày xyz có hàng Nhập với mã chưa có thì lập tức mã đó được ghi vào sổ. Không có chuyện có mã trong sheet KHO mà lại không có trong sheet Danh Mục. Nếu sổ sách nghiêm chỉnh thì khi mặt hàng nào đó không còn thì mã tương ứng sẽ bị xóa. Khi đó thì mỗi mã trong sheet KHO sẽ có trong sheet Danh Muc, và ngược lại. Có đk này thì không phải xét từng mả một trong vòng lặp 65000. Vì lúc đó ta "nhắm mắt" mà cho Danh Mục vào Collection, đít thon, mảng.

 

[ptm0412]

Tôi đã thử chuyển Thời gian tính giảm đi khoảng 10% khi dùng collection so với dictionary - Tuy nhiên thời gian vẫn dài hơn (chậm) so với collection của vodoi2x ở bài 156

code chuyển sang collection từ code gốc PTM bài 162
(có thể chưa thật hiểu thuật toán gốc - nên có thể việc chuyển sang collection chưa hoàn hảo nên chưa phát huy được hết mặt mạnh code gốc, ---> nên mọi người cứ thử kiểm tra và check xem sao)

Vodoi2x đã chuyển giúp code từ Dic sang collection. Tốc độ đã tăng và đã giữ nguyên thuật toán. Xin cám ơn vodoi2x.
Tôi cũng thử tự mình chuyển sang collection và test thì thấy như sau:

Sub LapSo()
  Application.ScreenUpdating = False
    Dim ListArr(), sArrID(), TmpArr(), RArr(), sArrQty(), sArrAmt(), sArrDocType()
    Dim sArrDate(), ColDM As Collection
    Dim EndR As Long, ListCt As Long
    Dim DataCt As Long, ListEndR As Long, Date1 As Long, Date2 As Long
    Dim i As Long, j As Long, k As Long, Check As Double
    ListEndR = Sheet1.[A100].End(xlUp).Row
    
    ''Lay danh muc vao mang
    ListArr = Sheet1.Range("A4:C" & ListEndR).Value2
    ListCt = UBound(ListArr, 1)
    
    Set ColDM = New Collection
    ''Nap mang danh muc vao Collection
    For i = 1 To ListCt
        ColDM.Add Item:=i, Key:=ListArr(i, 1)
    Next
    
    ''Xác dinh dong cuoi cua data va nap vao mang
    With Sheet20
    EndR = .Cells(65536, 1).End(xlUp).Row
        sArrID = .Range("G4:G" & EndR).Value2
        sArrQty = .Range("H4:H" & EndR).Value2
        sArrAmt = .Range("K4:K" & EndR).Value2
        sArrDocType = .Range("J4:J" & EndR).Value2
        sArrDate = .Range("B4:B" & EndR).Value2
    End With
    DataCt = EndR - 3
    '' gan gia tri cho bien
    ReDim TmpArr(1 To ListCt, 1 To 7)
    Date1 = Sheet3.[B1]
    Date2 = Sheet3.[B2]
    ''Duyet mang Data
    For i = 1 To DataCt
            j = ColDM.Item(sArrID(i, 1))
            
        ''Neu ngay < ngay bat dau, tinh 2 cot ton dau
        If sArrDate(i, 1) < Date1 Then
            If sArrDocType(i, 1) = "N" Then
                ''Cong nhap
                TmpArr(j, 2) = TmpArr(j, 2) + sArrQty(i, 1)
                TmpArr(j, 3) = TmpArr(j, 3) + sArrAmt(i, 1)
            Else
                ''Tru xuat
                TmpArr(j, 2) = TmpArr(j, 2) - sArrQty(i, 1)
                TmpArr(j, 3) = TmpArr(j, 3) - sArrAmt(i, 1)
            End If
        ''Neu ngay trong khoang bao cao
        ElseIf sArrDate(i, 1) <= Date2 Then
            ''Neu loai chung tu là N, tinh 2 cot Nhap
            If sArrDocType(i, 1) = "N" Then
                TmpArr(j, 4) = TmpArr(j, 4) + sArrQty(i, 1)
                TmpArr(j, 5) = TmpArr(j, 5) + sArrAmt(i, 1)
            ''Neu loai chung tu la X, tinh 2 cot xuat
            Else
                TmpArr(j, 6) = TmpArr(j, 6) + sArrQty(i, 1)
                TmpArr(j, 7) = TmpArr(j, 7) + sArrAmt(i, 1)
            End If
        End If
    ''Ket thuc vong lap, Mang KQ tam co 12 dong
    Next
    ''Khai bao  Mang KQua
    ReDim RArr(1 To ListCt, 1 To 12)
    k = 0
    ''Duyet mang KQ tam
    For i = 1 To ListCt
            ''Kiem tra dong co du lieu
              Check = TmpArr(i, 2) + TmpArr(i, 3) + TmpArr(i, 4) + _
            TmpArr(i, 5) + TmpArr(i, 6) + TmpArr(i, 7)
        ''Neu co dulieu, them vao mang KQua
        If Check > 0 Then
            k = k + 1
            ''4 cot thong so Hang hoa
            RArr(k, 1) = k
            If i <= ListCt Then
                RArr(k, 2) = ListArr(i, 1)
                RArr(k, 3) = ListArr(i, 2)
                RArr(k, 4) = ListArr(i, 3)
            Else
                RArr(k, 2) = TmpArr(i, 1)
            End If
            ''6 cot Ton, nhap, xuat
            For j = 5 To 10
               RArr(k, j) = TmpArr(i, j - 3)
            Next
            ''2 cot Ton cuoi
            RArr(k, 11) = RArr(k, 5) + RArr(k, 7) - RArr(k, 9)
            RArr(k, 12) = RArr(k, 6) + RArr(k, 8) - RArr(k, 10)
           
        End If
    Next
    '' Gan ket qua xuong sau khi xoa
    Sheet26.[B12].Resize(12, 12).ClearContents
    Sheet26.[B12].Resize(k, 12) = RArr
    
    
Set ColDM = Nothing
Application.ScreenUpdating = True
End Sub

Tôi phân tích thế này:

1. Collection nhanh hơn Dic trong bài toán này.
2. Cùng là Dic, nhưng của tôi nhanh hơn của vodoi2x vì tôi dùng 1 Dic, Vodoi dùng 2 Dic
3. Cùng là Collection, nhưng code Vodoi2x nhanh hơn, vì tôi dùng mảng tạm, thêm 1 vòng lặp kiểm tra mới đưa ra kết quả. Lý do thì như đã nói, tôi viết code theo thói quen nhận định rằng có thể có mặt hàng không nhập xuất nhưng có tồn đầu
4. Code tôi tự chuyển sang Collection nhanh hơn code vodoi2x chuyển giúp vì vodoi2x có kiểm tra dữ liệu nếu có mặt hàng không có trong danh mục thì add vào, còn tôi thì không kiểm tra. Lý do thì cũng đã nói: Dữ liệu phải được kiểm tra từ lúc nhập, nếu không có mã hàng thì không cho nhập xuất.

Nói thêm:
Do đầu bài không cho sửa Data, trong khi Data không được sort theo thứ tự ngày tháng (do giả lập bằng cách copy và sửa chút đỉnh), nên tôi viết theo thuật toán thế này.
Nếu Dữ liệu thực, nhập hàng ngày theo thứ tự thời gian đúng chuẩn dữ liệu hơn nữa, và có đầu kỳ <> 0 chung với danh mục (hoặc 1 bảng đầu kỳ riêng), tôi sẽ viết kiểu khác:

- Tạo 2 name động cho dữ liệu: 1 cho dữ liệu trước ngày bắt đầu, và 1 cho dữ liệu trong khoảng báo cáo.
- Tạo 2 mảng tương ứng 2 name trên dùng làm mảng nguồn.
- Nếu số dư đầu kỳ chung bảng với danh mục, dùng 1 Dic, nếu số dư đầu kỳ khác bảng, dùng 2 Dic.
- nếu danh mục ít, không có Dic nào được nạp từ dữ liệu, Dic chỉ nạp 1 lần và chỉ dùng để truy xuất.
- nếu danh mục dài, 1 Dic chứa số dư và 1 Dic lấy từ dữ liệu, chấp nhận test If Exist
- Nếu thích Collection thì dùng collection. Số lượng và cách dùng tương tự Dic

 

[Hoàng Trọng Nghĩa]

Thực ra giả thuyết của sư phụ cũng rất đơn giản
Thì chỉ cần sửa lại 1 chut là xong
thầy thử test file xem có còn sai chỗ nào không giúp em.
thông thường em vẫn dùng pivot table để lấy kết quả sau đó copy vào mẫu báo cáo là xong
sếp chỉ cần xem kết quả khi in ra va ký duyệt.
Không biết có phải lê duy thương nghiện pivot table hay không mà khi gặp những dữ liệu lớn thường nghĩ ngay đến pivot table.sau đó mới đến công cụ khác.

Chú làm tốt lắm đó! Ngày càng thâm hậu về PivotTable nhỉ!

Máy chú tốt, test dùm code tôi mới sửa lại theo cách kết hợp giữa thuật toán Lão Chết Tiệt làm, theo Collection của Vodoi2x và Mảng trong Mảng của tớ xem thời gian có khá hơn không nhé! Máy tớ cứ như rùa bò ấy!

Option Explicit
Public ArrData

Sub LapSo1()
    Application.ScreenUpdating = False
    Static ArrList(), Ubd As Long, Collect As New Collection
    Dim c As Long, r As Long, n As Long
    If Not IsArray(ArrData) Then
        Dim RowCount As Long, LastRow As Long
        ''Du cho thoi gian co cham may cung phai dung thu tuc kiem tra AutoFilterMode,
        ''neu khong co hang nay va sheet co Filter thi se co kha nang bien LastRow
        ''bi mat hang:
        If Sheets("KHO").AutoFilterMode Then Sheets("KHO").AutoFilterMode = False
        ''Luong truoc viec "Over Float" cua sheet khi "can dong", dung End la khong duoc,
        ''dong thoi du cho Excel 2003 hay 2013 van dung duoc: (moi nhan dinh them)
        RowCount = Range("A:A").Rows.Count
        If Sheets("KHO").Range("A" & RowCount) = "" Then
            LastRow = Sheets("KHO").Range("A" & RowCount).End(xlUp).Row
        Else
            LastRow = RowCount
        End If
        ''Luong truoc kha nang du lieu tai KHO chua nhap du lieu:
        If LastRow <= 3 Then
            MsgBox "Tai sheet 'KHO' chua co du lieu nao!"
            Exit Sub
        End If
        
        ReDim ArrData(1 To 5)
        With Sheets("KHO").Range("B4:B" & LastRow)
            ArrData(1) = .Offset(, 5).Value2    'MA_VLSPHH
            ArrData(2) = .Offset(, 6).Value2    'SLG
            ArrData(3) = .Offset(, 9).Value2    'THANH_TIEN
            ArrData(4) = .Offset(, 8).Value2    'LOAI_PHIEU
            ArrData(5) = .Value2                'NGAY_CT
        End With
        
        ''Neu du lieu chi co 1 dong duy nhat:
        If Not IsArray(ArrData(1)) Then
            Dim ArrTemp(1 To 1, 1 To 1)
            For c = 1 To 5
                ArrTemp(1, 1) = ArrData(c)
                ArrData(c) = ArrTemp
            Next
        End If
        LastRow = Sheets("DM VLSPHH").Range("A" & RowCount).End(xlUp).Row
        ''Danh muc hang hoa:
        ArrList = Sheets("DM VLSPHH").Range("A4:C" & LastRow).Value2
        Ubd = UBound(ArrList)
        Set Collect = Nothing
        For r = 1 To Ubd
            Collect.Add r, ArrList(r, 1)
        Next
    End If
        
    Dim ItmID As String
    Dim ArrReport(), General()
    Dim CondDate As Long, FromDate As Long, ToDate As Long, Index As Long
    Dim Balance_In_Out(1 To 3), Quantity_Amount(1 To 2), ArrToTal(3 To 12)
    
    FromDate = Range("NGAY1").Value2
    ToDate = Range("NGAY2").Value2
    
    For r = 1 To 3
        Balance_In_Out(r) = Quantity_Amount
    Next
    
    ReDim General(1 To Ubd)
    For r = 1 To Ubd
        General(r) = Balance_In_Out
    Next
    
    For r = 1 To UBound(ArrData(1))
        ''Ma san pham theo tung record:
        ItmID = ArrData(1)(r, 1)
        ''Ngay de tinh dieu kien:
        CondDate = ArrData(5)(r, 1)
        ''Truy van index tu Collect:
        Index = Collect.Item(ItmID)
        ''Neu ngay dieu kien nho hon ngay bat dau:
        If CondDate < FromDate Then
            ''Neu cot Loai_Phieu la Nhap:
            If ArrData(4)(r, 1) = "N" Then
                General(Index)(1)(1) = General(Index)(1)(1) + ArrData(2)(r, 1)  'SLG
                General(Index)(1)(2) = General(Index)(1)(2) + ArrData(3)(r, 1)  'THANH_TIEN
            ''Neu la Xuat:
            Else
                General(Index)(1)(1) = General(Index)(1)(1) - ArrData(2)(r, 1)  'SLG
                General(Index)(1)(2) = General(Index)(1)(2) - ArrData(3)(r, 1)  'THANH_TIEN
            End If
        ''Neu ngay dieu kien nho hon hoac ban ngay ket thuc:
        ElseIf CondDate <= ToDate Then
            If ArrData(4)(r, 1) = "N" Then
                General(Index)(2)(1) = General(Index)(2)(1) + ArrData(2)(r, 1)  'SLG
                General(Index)(2)(2) = General(Index)(2)(2) + ArrData(3)(r, 1)  'THANH_TIEN
            Else
                General(Index)(3)(1) = General(Index)(3)(1) + ArrData(2)(r, 1)  'SLG
                General(Index)(3)(2) = General(Index)(3)(2) + ArrData(3)(r, 1)  'THANH_TIEN
            End If
        End If
    Next
    
    ReDim ArrReport(1 To Ubd, 1 To 12)
    For r = 1 To Ubd
        ''Neu SL Ton dau va SL Nhap lon hon 0:
        If General(r)(1)(1) + General(r)(2)(1) > 0 Then
            n = n + 1
            ArrReport(n, 1) = n                                                     'STT
            ArrReport(n, 2) = ArrList(n, 1)                                         'MA
            ArrReport(n, 3) = ArrList(n, 2)                                         'TEN
            ArrReport(n, 4) = ArrList(n, 3)                                         'DVT
            ArrReport(n, 5) = General(n)(1)(1)                                      'SL_TON
            ArrReport(n, 6) = General(n)(1)(2)                                      'TT_TON
            ArrReport(n, 7) = General(n)(2)(1)                                      'SL_NHAP
            ArrReport(n, 8) = General(n)(2)(2)                                      'TT_NHAP
            ArrReport(n, 9) = General(n)(3)(1)                                      'SL_XUAT
            ArrReport(n, 10) = General(n)(3)(2)                                     'TT_XUAT
            ArrReport(n, 11) = ArrReport(n, 5) + ArrReport(n, 7) - ArrReport(n, 9)  'SL_TONCUOI
            ArrReport(n, 12) = ArrReport(n, 6) + ArrReport(n, 8) - ArrReport(n, 10) 'TT_TONCUOI
            'Dung cho viec total:
            For c = 5 To 12
                ArrToTal(c) = ArrToTal(c) + ArrReport(n, c)
            Next
        End If
    Next
    
    Sheets("THNXT").Range("B12:M24").ClearContents
    
    If n Then
        ''Tieu de cho hang TONG CONG:
        ArrToTal(3) = "T" & ChrW(7892) & "NG C" & ChrW(7896) & "NG:"
        Sheets("THNXT").Range("B12").Resize(n, 12) = ArrReport
        Sheets("THNXT").Range("D24:M24") = ArrToTal
    End If
    
    Application.ScreenUpdating = True
End Sub