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

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

hphuc0210 · 12/2/14

ndu96081631 đã viết:
Bị... biết là có nộp bài cũng thua nên khỏi nộp cho nó chắc
Ẹc... Ẹc...

E nghĩ thầy k để ý nhiều đến chuyện thắng thua đâu.Và cái e mong đợi không phải xem ai là người giỏi nhất,e mong thấy giải thuật của thầy thế nào.Vì e thấy ai nộp bài ở đây điều là giỏi và có kiến thức cả rồi .Hi vọng thầy cũng tham gia để mọi người cùng trao đổi thầy nhé.

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

nguyễn duy tuân đã viết:
mình đã nhận được bài của bạn lê duy thưởng. Tốc độ code trong thủ tục "an_gian" rất nhanh . Mình có chút góp ý mong bạn chỉnh thêm.

Trong sổ thnxt, nếu người dùng xóa từ dòng 12 đến một số dòng nào đó thì code sẽ báo lỗi. Có thể trong sheet thnxt bạn đã "iểm bùa" pivot table? Nếu là pivot table cũng là một giải pháp nhưng ta nên làm nhứ sau trong code để không bị "gian".
Viết code kiểm tra pivot đã tồn tại chưa? Nếu chưa thì tạo nó. Trước khi chạy "thực hiện" để đo tốc độ sheet thnxt phải chưa có pivot.
Trong một chương trình ứng dụng, nếu mỗi báo cáo ta lưu cấu trúc pivot dung lượng file sẽ nặng, vậy trước khi lệnh save được thực hiện cần xóa pivot (một trong các yếu tốt quan trọng làm cho file excel chạy nhanh và dung lượng nhẹ là xóa liên kết, công thức). Vậy nên trong thực tế ứng dụng theo cách tạo pivot, lần đầu tạo sổ thnxt sẽ bị chậm vì phải tạo, còn lần sau (khi chưa lưu) chạy sẽ rất nhanh.

cảm ơn anh đã gợi ý.tôi đã viết code và gửi lại bài hy vọng vẫn còn lỗi để anh góp ý thêm.

Toàn bộ code tôi để trong module "angian". Do không có trường lớp nghĩ sao viết vậy. Hy vọng học thêm được ít nữa trong topic này --=0

Quang_Hải · 12/2/14

Mình viết theo kiểu VBA căn bản thì ra thế này. Biết không phải là đối thủ nên hỏng dám bon chen thi thố. Thôi thì post code lên mọi người góp ý giúp thôi. Hic cái hình có chút xíu

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

quanghai1969 đã viết:
Mình viết theo kiểu VBA căn bản thì ra thế này. Biết không phải là đối thủ nên hỏng dám bon chen thi thố. Thôi thì post code lên mọi người góp ý giúp thôi. Hic cái hình có chút xíu

- Khi định dạng hình sau khi PrintScreen thì cho nó đuôi JPG thì sẽ cho ra ảnh lớn.

- Với code chạy 435 ms thì thuộc hàng khủng rồi, nộp bài đi anh Hải ơi.

vodoi2x · 12/2/14

siwtom đã viết:
Sao máy của bạn nhanh thế? Máy của tôi là quãng 4200
------------
..............
Như thế sai số có thể là 20 ms. Vậy thì chả lý gì lại phải dùng QueryPerformanceFrequency + QueryPerformanceCounter. Với sai số cỡ đó thì dùng GetTickCount là đủ.

---
Vả lại nếu cần so sánh 2 gói đường mà chúng khác nhau ít nhất là cỡ 1 gam thì chả cần dùng cân có độ chính xác là 1 phần trăm (phần nghìn) gam

thế máy tính của bác hơi chậm thật, hihii, máy tính của bac bate còn có khoảng 845

Đúng là GetTickcount là đủ, đã dùng thử timer thường thấy cũng giống nhau cả

QuangHai, HoangTrongNhia, PTM sao không thử test thời gian (bài #64) tại máy tính các bạn chạy code , để hình dung xem tốc độ thử code thế nào???

Quang_Hải · 12/2/14

Mình test code của bài 64, bấm 10 lần cho ra số 869.666. Nhưng thật tình chẳng hiểu gì ráo nghen.

vodoi2x · 12/2/14

quanghai1969 đã viết:
Mình test code của bài 64, bấm 10 lần cho ra số 869.666. Nhưng thật tình chẳng hiểu gì ráo nghen.

Xem thêm bài #66 , sẽ hiểu thui,

Vì nếu có 2 người cùng công bố các 2 con số (số mls của code, số mls của Sub test thời gian (sub này giống nhau) ) thì sẽ có thể suy luận so sánh tương đối về tốc độ code của 2 người dù dùng 2 máy tính khác nhau

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

vodoi2x đã viết:
thế máy tính của bác hơi chậm thật, hihii, máy tính của bac bate còn có khoảng 845

Đúng là GetTickcount là đủ, đã dùng thử timer thường thấy cũng giống nhau cả

QuangHai, HoangTrongNhia, PTM sao không thử test thời gian (bài #64) tại máy tính các bạn chạy code , để hình dung xem tốc độ thử code thế nào???

Bấm 10 nhát, kết quả trung bình: 2407.578

Thấp nhất: 1792.88671770278

Cao nhất: 3014.64899019987

vodoi2x · 12/2/14

Hoàng Trọng Nghĩa đã viết:
Bấm 10 nhát, kết quả trung bình: 2407.578

Thấp nhất: 1792.88671770278

Cao nhất: 3014.64899019987

Thế thì hoặc con số có vấn đề hoặc là HTN chạy test thời gian khi đang chạy cùng nhiều chương trình khác (chi phối CPU) nên con số quá dao động, thiếu chính xác

Thường các con số 10 lần không khác nhau nhiều đâu thường dao động +-20mls

Nên tắt các chương trình khác, và theo các hướng dẫn trên của NDT khi test thời gian

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

vodoi2x đã viết:
Thế thì hoặc con số có vấn đề hoặc là HTN chạy test thời gian khi đang chạy cùng nhiều chương trình khác (chi phối CPU) nên con số quá dao động, thiếu chính xác

Thường các con số 10 lần không khác nhau nhiều đâu thường dao động +-20mls

Nên tắt các chương trình khác, và theo các hướng dẫn trên của NDT khi test thời gian

Khởi động máy, không mở bất cứ gì khác, kể cả rút khỏi cục 3G, mở Excel và bấm 10 nhát:

MIN: 1781.816599

MAX: 2365.375199

AVG: 2038.719

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

nhờ anh tuân add cho dòng màu đỏ nhé.
do copy thiếu

Sub PIVOT_ADD()
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
On Error Resume Next
Sheets("PV").Visible = True
Sheets("PV").DELETE

ct ="Từ ngày " & TEXT(NGAY1,"dd/mm/yy") & " đến " & TEXT(NGAY2,"dd/mm/yy") bị value

ptm0412 · 12/2/14

Tôi không có thì giờ sửa lại để tối ưu, nên post luôn lên đây sau khi comment:

PHP:

Sub LapSo()

    Application.ScreenUpdating = False
    Dim ListArr, sArr, TmpArr, RArr
    Dim Dic1 As Object, EndR As Long, ListCt As Long
    Dim DataCt As Long, ListEndR As Long, Date1 As Long, Date2 As Date
    Dim i As Long, j As Long, k As Long, Check As Double

    ListEndR = Sheet1.[A100].End(xlUp).Row
    Set Dic1 = CreateObject("Scripting.Dictionary")

    'Lay danh muc vao mang'
    ListArr = Sheet1.Range("A4:C" & ListEndR).Value
    ListCt = UBound(ListArr, 1)

    'Nap mang danh muc vao Dic'
    For i = 1 To ListCt
        Dic1.Add ListArr(i, 1), i
    Next

    'Xác dinh dong cuoi cua data va nap vao mang'
    EndR = Sheet20.Cells(4, 1).End(xlDown).Row
    sArr = Sheet20.Range("A4:K" & EndR).Value
    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
            ' Xac dinh dong chua ma HH trong danh muc, gan vao cot 1 cua KQ tam'
            j = Dic1.Item(sArr(i, 7))
            TmpArr(j, 1) = j
       'Neu ngay < ngay bat dau, tinh 2 cot ton dau'
        If sArr(i, 2) < Date1 Then
            If sArr(i, 10) = "N" Then
                'Cong nhap'
                TmpArr(j, 2) = TmpArr(j, 2) + sArr(i, 8)
                TmpArr(j, 3) = TmpArr(j, 3) + sArr(i, 11)
            Else
                'Tru xuat'
                TmpArr(j, 2) = TmpArr(j, 2) - sArr(i, 8)
                TmpArr(j, 3) = TmpArr(j, 3) - sArr(i, 11)
            End If
        'Neu ngay trong khoang bao cao'
        ElseIf sArr(i, 2) <= Date2 Then
            'Neu loai chung tu là N, tinh 2 cot Nhap'
            If sArr(i, 10) = "N" Then
                TmpArr(j, 4) = TmpArr(j, 4) + sArr(i, 8)
                TmpArr(j, 5) = TmpArr(j, 5) + sArr(i, 11)
            'Neu loai chung tu la X, tinh 2 cot xuat'
            Else
                TmpArr(j, 6) = TmpArr(j, 6) + sArr(i, 8)
                TmpArr(j, 7) = TmpArr(j, 7) + sArr(i, 11)
            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
            RArr(k, 2) = ListArr(i, 1)
            RArr(k, 3) = ListArr(i, 2)
            RArr(k, 4) = ListArr(i, 3)
            '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 Dic1 = Nothing
Application.ScreenUpdating = True
End Sub

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

ptm0412 đã viết:

Tôi không có thì giờ sửa lại để tối ưu, nên post luôn lên đây sau khi comment:

Mã:

Sub LapSo()

    Dim DataCt As Long, ListEndR As Long, [COLOR=#0000ff][B]Date1 As [/B][/COLOR][COLOR=#ff0000][B]Long[/B][/COLOR][COLOR=#0000ff][B], Date2 As [/B][/COLOR][COLOR=#00ff00][B]Date[/B][/COLOR][COLOR=#0000ff][/COLOR]
    Dim i As Long, j As Long, k As Long, Check As Double

    ListEndR = Sheet1.[A100].End(xlUp).Row
    Set Dic1 = CreateObject("Scripting.Dictionary")

    ‘‘Lay danh muc vao mang
    ListArr = Sheet1.Range("A4:C" & ListEndR).Value
    ListCt = UBound(ListArr, 1)

[COLOR=#ff0000]    ‘‘Nap mang danh muc vao Dic
    For i = 1 To ListCt
        Dic1.Add ListArr(i, 1), i
    Next
[/COLOR]
    ‘‘Xác dinh dong cuoi cua data va nap vao mang
    EndR = Sheet20.Cells(4, 1).End(xlDown).Row
    sArr = Sheet20.Range("A4:K" & EndR).Value
    DataCt = EndR - 3

    ‘‘ gan gia tri cho bien
    ReDim TmpArr(1 To ListCt, 1 To 7)
    [COLOR=#0000ff]Date1 = Sheet3.[B1]
    Date2 = Sheet3.[B2][/COLOR]

''........

End Sub

Lâu lâu mình làm nhà phê bình cái coi!

1) 2 biến đều nhận giá trị là DATE, nhưng có 1 biến LONG, 1 biến DATE

2) Dict chạy toàn bộ mảng nguồn, đồng thời add toàn bộ như thế có bị xem là hao phí hay không, trong khi người ta chỉ chặn ĐẾN NGÀY, giả sử người ta chỉ lấy từ 1/1/2005 đến 31/12/2005 thì nó vẫn Add luôn cả những năm sau à?

3) Sau khi xuất ra kết quả, không có dòng Total thì vẫn chưa đạt yêu cầu!

Người ta thường nói:

Cười người hôm trước, hôm sau người cười

Vậy tại sao mình "không cười người hôm trước, nếu không cười thì hôm sau còn đâu cơ hội mà cười" kakaka.

ptm0412 · 12/2/14

Hoàng Trọng Nghĩa đã viết:
Lâu lâu mình làm nhà phê bình cái coi!

1) 2 biến đều nhận giá trị là DATE, nhưng có 1 biến LONG, 1 biến DATE

2) Dict chạy toàn bộ mảng nguồn, đồng thời add toàn bộ như thế có bị xem là hao phí hay không, trong khi người ta chỉ chặn ĐẾN NGÀY, giả sử người ta chỉ lấy từ 1/1/2005 đến 31/12/2005 thì nó vẫn Add luôn cả những năm sau à?

3) Sau khi xuất ra kết quả, không có dòng Total thì vẫn chưa đạt yêu cầu!

Người ta thường nói:

Cười người hôm trước, hôm sau người cười

Vậy tại sao mình "không cười người hôm trước, nếu không cười thì hôm sau còn đâu cơ hội mà cười" kakaka.

Muốn cười thì cứ cười.
1. 1 Date, 1 Long, không thấy là tôi cố tình sao?
2. Dict làm gì chạy toàn bộ mảng data nguồn? đọc lại cho kỹ vào: Chạy toàn bộ bảng danh mục 12 dòng. Thậm chí không test If exist. Vả lại ngày tháng trong data không được sort, nếu không có bảng danh mục cũng phải duyệt 65000 dòng như thường.
3. Dòng total có sẵn, đóng khung riêng, format bold, theo mẫu của chủ topic, không yêu cầu thêm vào. Nếu là tôi thì sau khi loại dòng không có tồn và nhập xuất, k <> ListCt, tôi xóa dữ liệu cũ, gán dữ liệu mới, giả sử 4 dòng, thì dòng tổng sẽ nằm ở dòng thứ 5 chứ không phải dòng 13 như vậy.

Cười được thì cứ cười. Còn tôi trước giờ không cười ai, chỉ góp ý. Tôi sai thì cứ góp ý. Được góp ý mà cãi tầm bậy mơi xấu.

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

ptm0412 đã viết:
Muốn cười thì cứ cười.
1. 1 Date, 1 Long, không thấy là tôi cố tình sao?
2. Dict làm gì chạy toàn bộ mảng data nguồn? đọc lại cho kỹ vào: Chạy toàn bộ bảng danh mục 12 dòng. Thậm chí không test If exist. Vả lại ngày tháng trong data không được sort, nếu không có bảng danh mục cũng phải duyệt 65000 dòng như thường.
3. Dòng total có sẵn, đóng khung riêng, format bold, theo mẫu của chủ topic, không yêu cầu thêm vào. Nếu là tôi thì sau khi loại dòng không có tồn và nhập xuất, k <> ListCt, tôi xóa dữ liệu cũ, gán dữ liệu mới, giả sử 4 dòng, thì dòng tổng sẽ nằm ở dòng thứ 5 chứ không phải dòng 13 như vậy.

Cười được thì cứ cười. Còn tôi trước giờ không cười ai, chỉ góp ý. Tôi sai thì cứ góp ý. Được góp ý mà cãi tầm bậy mơi xấu.

Câu 1: Cố tình? Tại sao?

Câu 2: ý nói là thay vì duyệt cột đó có điều kiện, đằng này lại add hết mã hàng kể cả mã hàng không cần thiết vào Dict. Nếu Sư phụ đã từng xem danh mục phụ tùng xe gắn máy của một đại lý thì Sư phụ sẽ ngất đi, 36000 dòng! Khiếp!

Câu 3: Vậy thì bổ sung thêm đi chứ nhỉ?

----------------------------------------------
Lâu lâu mới bắt giò được Sư phụ của mình cũng khá vui, chứ mình bị Sư phụ trảm hoài chán chết đi được!

ptm0412 · 12/2/14

Data của chủ topic không sắp xếp theo thời gian:Các năm 2005 và 2006 xen kẽ nhau: dòng 65460 là năm 2006, dòng 65461 - 65499 là năm 2005, các dòng kế lại 2006, 5 dòng cuối lại 2005.

Vậy phải giả định rằng phải duyệt hết 65000 dòng data mới lấy đủ các mặt hàng. Nhưng đã có bảng danh mục 12 dòng thì có mà ngu mới duyệt bên Data.

Danh mục có 10.000 dòng hay 36000 dòng cũng phải add cho hết. Vì phải giả định bất kỳ mặt hàng nào cũng có thể có giao dịch mua bán. Sau khi gán giá trị giao dịch vào rồi mới loại ra.

Dòng tổng chủ topic có sẵn và cố định tại dòng thứ 13 (danh mục có 12 mặt hàng), thì bổ sung bằng công thức Sum cố định vào dòng đó (trên sheet), mắc gì mỗi lần chạy code phải tính lại cho 1 vị trí cố định, công thức cố định?

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

ptm0412 đã viết:
Data của chủ topic không sắp xếp theo thời gian:Các năm 2005 và 2006 xen kẽ nhau: dòng 65460 là năm 2006, dòng 65461 - 65499 là năm 2005, các dòng kế lại 2006, 5 dòng cuối lại 2005.

Vậy phải giả định rằng phải duyệt hết 65000 dòng data mới lấy đủ các mặt hàng. Nhưng đã có bảng danh mục 12 dòng thì có mà ngu mới duyệt bên Data.

Danh mục có 10.000 dòng cũng phải add cho hết. Vì phải giả định bất kỳ mặt hàng nào cũng có thể có giao dịch mua bán. Sau khi gán giá trị giao dịch vào rồi mới loại ra.

Bắt giò thì phải bắt cho đúng, thậm chí nếu bắt giò đúng mà bị phản biện cũng phải biết cách bảo vệ lý luận của mình.

OK, mỗi người có một lý do, một thuật toán để làm, vậy câu 1 tại sao cố tình đặt biến này, biến kia vậy? Hỏi để học kiểu biến này. Có gì đặc biệt nên cố tình làm thế sao Sư phụ? Nhầm lẫn thì bình thường, còn cố tình thì rất không hiểu tại sao!

Quang_Hải · 12/2/14

Mình thấy thuật toán bài 112 là rất hợp lý rồi. Đơn giản, dễ hiểu và tốc độ cũng cực nhanh. Mình cũng code bài này gần như giống bài 112. Tuy nhiên lúc xem cách khai báo cũng có hơi thắc mắc chút và mình nghĩ chắc là kỹ thuật là chỗ này nên code có vẻ nhanh hơn code mình nhiều.

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

Các anh giải thích như thế là được rồi

. Mong các thành viên tiếp tục gửi bài nhé.

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

quanghai1969 đã viết:
Mình thấy thuật toán bài 112 là rất hợp lý rồi. Đơn giản, dễ hiểu và tốc độ cũng cực nhanh. Mình cũng code bài này gần như giống bài 112. Tuy nhiên lúc xem cách khai báo cũng có hơi thắc mắc chút và mình nghĩ chắc là kỹ thuật là chỗ này nên code có vẻ nhanh hơn code mình nhiều.

Ý của anh Quang Hải là biến gì vậy ạ? Còn biến LONG thay bằng biến DATE cũng vậy thôi à, vì tất cả cũng chỉ là dạng NUMBER, nhưng khai như thế nó thấy kỳ và chổi chổi thế thôi.

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

anh hải gửi bài đi chứ.
HTN để đến hết ngày 15 hãy tiếp tục tranh luận nhé. --=0

ndu96081631 · 12/2/14

hphuc0210 đã viết:
E nghĩ thầy k để ý nhiều đến chuyện thắng thua đâu.Và cái e mong đợi không phải xem ai là người giỏi nhất,e mong thấy giải thuật của thầy thế nào.Vì e thấy ai nộp bài ở đây điều là giỏi và có kiến thức cả rồi .Hi vọng thầy cũng tham gia để mọi người cùng trao đổi thầy nhé.

Mình đùa tí thôi! Thật ra là dạo này bận quá, không thể làm gì được
Viết code phải có hứng và cần có thời gian. Tính mình vốn cẩn thận, thà không viết thì thôi, nếu đã viết thì phải đàng hoàng, không thể viết bừa cho có được
(một code đơn giản có khi phải sửa đi sửa lại vài chục lần mà vẫn chưa vừa ý)

ptm0412 · 12/2/14

quanghai1969 đã viết:
Mình thấy thuật toán bài 112 là rất hợp lý rồi. Đơn giản, dễ hiểu và tốc độ cũng cực nhanh. Mình cũng code bài này gần như giống bài 112. Tuy nhiên lúc xem cách khai báo cũng có hơi thắc mắc chút và mình nghĩ chắc là kỹ thuật là chỗ này nên code có vẻ nhanh hơn code mình nhiều.

Ban đầu tôi khai báo cả 2 biến là Long, sau đó sửa lại 1 biến thành Date là để kiểm tra dữ liệu ngày tháng xem sau khi tính lại có bị thay đổi kết quả không. Vì trước đây có lần tôi khai báo biến Long không được, biến date cũng không được, phải dùng CLng() tất tần tật để so sánh mới xong. Lần này tôi test xem nếu dữ liệu chuẩn thì có bị lỗi như lần trước hay không.

Kết luận là nếu dữ liệu chuẩn thì biến nào cũng OK. Tuy nhiên cũng có khi do định dạng sai 1 vài ô, do lỗi bản thân anh Bill, phải xoay sở chán chê mới được.

Cuối cùng là test thấy vẫn ok nên không sửa.

Quang_Hải · 12/2/14

Lê Duy Thương đã viết:
anh hải gửi bài đi chứ.
HTN để đến hết ngày 15 hãy tiếp tục tranh luận nhé.

Mình có đặc điểm là viết code cực nhanh và cực ẩu luôn, khai báo biến thì tá lả và chẳng bao giờ có chú thích trong code vì chẳng có biết chú thích. Bài này mình thử rồi hôm qua, thuật toán 99% giống bài 112. Thôi thì mạn phép anh PTM cho mình mược code đó thi luôn nha.

Nhưng mà xem thời gian của bài 102 thì chẳng còn ý chí thi thố gì nữa cả. Hỏng biết là tà thuật kiểu gì trong code nữa. Cảm giác nghi ngờ nhiều lắm. Vì code kiểu gì cũng không thể nào được như thế. Khiếp.

ptm0412 · 13/2/14

quanghai1969 đã viết:
Mình có đặc điểm là viết code cực nhanh và cực ẩu luôn, khai báo biến thì tá lả và chẳng bao giờ có chú thích trong code vì chẳng có biết chú thích. Bài này mình thử rồi hôm qua, thuật toán 99% giống bài 112. Thôi thì mạn phép anh PTM cho mình mược code đó thi luôn nha.

Nhưng mà xem thời gian của bài 102 thì chẳng còn ý chí thi thố gì nữa cả. Hỏng biết là tà thuật kiểu gì trong code nữa. Cảm giác nghi ngờ nhiều lắm. Vì code kiểu gì cũng không thể nào được như thế. Khiếp.

1% còn lại có lẽ là các chỗ sau:
- Cột 1 Số thứ tự của kết quả ăn gian theo biến k
- Mảng tạm của tôi chỉ có 7 cột, không có 2 cột tồn cuối
- Công thức Check để loại
- Số lần IF

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

quanghai1969 đã viết:
Nhưng mà xem thời gian của bài 102 thì chẳng còn ý chí thi thố gì nữa cả. Hỏng biết là tà thuật kiểu gì trong code nữa. Cảm giác nghi ngờ nhiều lắm. Vì code kiểu gì cũng không thể nào được như thế. Khiếp.

Bài của Lê Duy Thương rất nhanh, dùng Pivot thì lọc lẹ nhất, mình cho rằng bạn hiền của mình biết cách dùng "Thủ Thuật" chứ không phải gọi là "Ăn Gian".

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

quanghai1969 đã viết:
Mình có đặc điểm là viết code cực nhanh và cực ẩu luôn, khai báo biến thì tá lả và chẳng bao giờ có chú thích trong code vì chẳng có biết chú thích. Bài này mình thử rồi hôm qua, thuật toán 99% giống bài 112. Thôi thì mạn phép anh PTM cho mình mược code đó thi luôn nha.

Nhưng mà xem thời gian của bài 102 thì chẳng còn ý chí thi thố gì nữa cả. Hỏng biết là tà thuật kiểu gì trong code nữa. Cảm giác nghi ngờ nhiều lắm. Vì code kiểu gì cũng không thể nào được như thế. Khiếp.

thực ra em cũng không biết nhiều về cái xnt này . nên em nghĩ vãn lỗi mà em không biết.còn tốc độ thì đúng là thật anh .
Hải à. --=0

EM ĐANG KIỂM TRA LẦN CUỐI ĐÚNG NGÀY 15 GƯI LUÔN BẢN FINAL --=0

ptm0412 · 13/2/14

Lê Duy Thương đã viết:
thực ra em cũng không biết nhiều về cái xnt này . nên em nghĩ vãn lỗi mà em không biết.còn tốc độ thì đúng là thật anh .
Hải à.
EM ĐANG KIỂM TRA LẦN CUỐI ĐÚNG NGÀY 15 GƯI LUÔN BẢN FINAL

Chắc chắn là có ăn gian, vì với pivot table:
- Với data này phải dùng ít ra là 2 pivot table chứ không phải 1. Nếu muốn ép về 1 Pivot table sẽ phải tạo cột phụ trong data
- Một lần refresh Pivot ít nhất 450 ms. Để nguyên nhấn nút hoài thì nhanh,, chứ sửa ngày bên sheet setting là phải refresh rồi mới tính.

Nhân tiện, code của mọi người dự thi phải chạy tốt và đúng khi thay dổi ngày bên setting, kể cả ngày bắt đầu là 01/07/2005 trở về trước (tồn đầu = 0)

vodoi2x · 13/2/14

Lê Duy Thương đã viết:
thực ra em cũng không biết nhiều về cái xnt này . nên em nghĩ vãn lỗi mà em không biết.còn tốc độ thì đúng là thật anh .
Hải à.
EM ĐANG KIỂM TRA LẦN CUỐI ĐÚNG NGÀY 15 GƯI LUÔN BẢN FINAL

Không rõ ý kiến chủ topic sao?

Còn theo như ở đây, tôi nghĩ các bạn lên post lên đây luôn, mọi người tiện so sánh, đánh giá, và góp ý hơn, chứ sau đó thì có khi không khí đã nguội thì ít người góp ý hơn,

Mọi người cho ý kiến, tôi sẽ viết code theo thuần VBA (không sử dụng các tools sẵn của excel như sort, pivot, filter ...vv) và gửi lên đây luôn? nên không?

SA_DQ · 13/2/14

[thongbao]Mọi người cho ý kiến, tôi sẽ viết code theo thuần VBA (không sử dụng các tools sẵn của excel như sort, pivot, filter ...vv) và gửi lên đây luôn? nên không?[/thongbao]
Nên quá chứ lị!
Có thể ai đó chưa thực sự vừa lòng; nhưng với số đông thì muốn được chia sẻ & học tập mà bạn!
& cũng có những bài đưa code lên rồi đó thay!
Thân ái & mong tin từ bạn!

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

vodoi2x đã viết:
Mọi người cho ý kiến, tôi sẽ viết code theo thuần VBA (không sử dụng các tools sẵn của excel như sort, pivot, filter ...vv) và gửi lên đây luôn? nên không?

không sao cả anh .tất cả giải pháp đều được hoan nghênh trong topic này.anh cứ gửi bai cho anh tuân. sau ngày 15 chắc chắn anh tuân sẽ post tất cả các bài lên topic này

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

vodoi2x đã viết:
Không rõ ý kiến chủ topic sao?

Còn theo như ở đây, tôi nghĩ các bạn lên post lên đây luôn, mọi người tiện so sánh, đánh giá, và góp ý hơn, chứ sau đó thì có khi không khí đã nguội thì ít người góp ý hơn,

Mọi người cho ý kiến, tôi sẽ viết code theo thuần VBA (không sử dụng các tools sẵn của excel như sort, pivot, filter ...vv) và gửi lên đây luôn? nên không?

Là do như các anh ở trên đã nói, thêm nữa là muốn các tác giả có nghiên cứu độc lập trong ví dụ này nên mới gửi bài riêng vào mail và công bố sau. Cũng chỉ còn 2 ngày nữa thôi nên vẫn theo như công bố ban đầu không vấn đề gì anh ạ. CÒn anh hay anh ptm muốn gửi code trực tiếp lên đây để mọi người xem và trao đổi luôn cũng được. Đặc biệt với giải pháp code VBA thuần túy, không sử dụng các công cụ hỗ trợ mạnh của Excel cũng là rất tốt cho người học VBA nắm rõ hơn về ngôn ngữ VBA.

siwtom · 13/2/14

Hoàng Trọng Nghĩa đã viết:
OK, mỗi người có một lý do, một thuật toán để làm, vậy câu 1 tại sao cố tình đặt biến này, biến kia vậy? Hỏi để học kiểu biến này. Có gì đặc biệt nên cố tình làm thế sao Sư phụ? Nhầm lẫn thì bình thường, còn cố tình thì rất không hiểu tại sao!

Chuyện góp ý là chuyện bình thường. Nhưng tôi thấy bạn "đeo bám" những cái tủn mủn quá.
Thế nếu không khai là Long mà khai là Variant thì có thấy kỳ không? Vì thực ra ngày tháng là kiểu Variant.
Nói trắng ra là ngày tháng được lưu ở dạng số (numeric) nên chuyện khai báo biến là Long chả có gì là ngồ ngộ cả. Thậm chí khai báo là Double cũng chả có gì là ngồ ngộ. Vì thực chất ngày giờ được lưu ở dạng đó. Chỉ có điều là ở đây ta chỉ làm việc với ngày tháng, không có thời gian, tức làm việc với số nguyên nên không cần tới Double mà chỉ cần Long. Nhu cầu chỉ cần tới numeric kiểu Long (4 bai) thì dùng Long là hợp lý. Đâu có cần, trong trường hợp chỉ có ngày mà không có giờ, tới kiểu Date - Variant - Double (8 bai)?

VetMini · 13/2/14

Xin lỗi trước, tôi quote cái này cốt chỉ nói chuyện cách thức thôi chứ không muốn phê bình code hay thủ thuật. Và hoàn toàn không có ý liên quan cá nhân.

Hoàng Trọng Nghĩa đã viết:
Khi làm một chương trình thì người thực hiện phải hoạch định xem mình sẽ làm gì để chương trình chạy mượt mà hơn.

Thứ hai là phải cân nhắc giữa cái nhanh và việc lường trước các lỗi phát sinh.

Với bài tập này, thay vì tôi chọn code chạy 450 ms thì tôi sẽ chọn loại 550 ms.

Lý do:

Kể từ đây về sau, các đoạn văn màu nâu là quote của tác giả, các đoạn màu xanh là diễn giải của tôi.

1) Tôi phải kiểm tra dữ liệu nguồn, cụ thể là sheet KHO có trạng thái AutoFilter hay không, nếu có thì tôi sẽ bỏ chế độ này. Một cơ sở dữ liệu mà đang bị Filter thì có khả năng chúng ta không thể gán vào Array đầy đủ.

Đây chỉ là bài toán chơi cho vui, cho nên chỉ cần phần code chính nằm gọn một chỗ là được. Khi áp dụng vào thực tế nguời copy code sẽ tự biết chèn thêm các phần kiểm soát.

2) Kiểm tra xem dữ liệu trong sheet KHO đã được nhập dòng nào chưa, nếu chưa nhập thì thông báo.

Đây chỉ là lập một bảng báo cáo/tóm tắt. Nếu cái gì cũng dùng message box để thông báo thì chạy mãi cũng không xong. Thường thì người ta có một cái log. Những gì trục trặc thì ghi vào log này. Người chạy code sẽ đọc cái log này để tìm ra những chỗ trục trặc. Chỉnh sửa và chạy lại.

Chỉ khi nào cần lấy kết quả làm đầu vào cho một chương trình khác thì mới bắt buộc phải chạy một lần thông suốt.

3) Kiểm tra xem Từ ngày, Đến ngày đã được nhập vào hay chưa, nếu chưa nhập hoặc không phải là dạng ngày cũng phải thông báo.

Nếu bài này đưa vào thực tế thì người ta sửa lại thành 1 sub, nhận các tham số:
- Vùng dữ liệu cần đọc (lưu ý là nếu làm trên thực tế, người ta sẽ có khuynh hướng dùng dữ liệu từ một file khác. Một hàm nào đó sẽ mở file này và tìm vùng dữ liệu. Cách này hữu hiệu hơn cho việc dùng ADO)
- Ngày (hoặc tháng, quý... thì có một hàm khác chuyển ra ngày) cần lọc
- Vùng dữ liệu chứa bảng mẫu báo cáo. Cách làm đúng là không viết lên bảng mẫu mà phải copy lại bảng mẫu rồi viết lên đó.

Trên thực tế, người ta sẽ có cái mà dân chuyên lập trình gọi là "Data Dictionary" (tiếng cũ) hoặc "Metadata" (tiếng cận đại hơn). Tức là một phần code chuyên diễn tả dữ liệu (các CSDL đều có phần này để định dạng dữ liệu)h. Tôi không quen VB cho nên không biết lập như thế nào là chuẩn nhất. Trước mắt nếu bắt buộc phải làm trên VBA thì tôi đặt một số hằng string xác định tên (headings) các cột trong bảng dữ liệu (Nhap, Xuat, ThanhTien, vv...). Sau đó dò tên cột để lấy các thông số về vị trí cột.

4) Xóa dữ liệu cũ trên biểu mẫu, bởi khi dữ liệu sắp nhập vào ít hơn dữ liệu cũ trên biểu mãu sẽ bị trộn dữ liệu.

Như đã đề cập ở trên. Cách làm đúng là không viết lên bảng mẫu mà phải copy lại bảng mẫu rồi viết lên đó.

5) Trong biểu mẫu, tôi luôn bảo toàn một số hàng nhất định, trong trường hợp này, tôi bảo toàn số hàng là 15 dòng. Vì vậy, tôi phải kiểm tra trước xem biểu mẫu đó có đủ 15 dòng chưa, nếu đủ thì thôi, không đủ thì Insert thêm, còn nếu hơn thì Delete đi, làm sao cho Insert hoặc Delete phải bảo toàn 15 dòng. Mặt khác ta phải xem số hàng mà ta sắp gán vào biểu mẫu có nhiều hơn 15 dòng hay không, nếu nhiều hơn thì ta Insert thêm (vẫn đảm bảo cấu trúc định dạng), không để tình trạng dữ liệu tràn.

Đúng như bạn nói, nếu code không thể đảm bảo các trường hợp bị tràn hoặc các trường hợp trục trặc thì đem so sánh tốc độ với nhau chưa hẳn là công bình.

------------------------------------------------
Tôi vẫn dùng Dictionary để thực hiện code vì nó đảm bảo mã vật tư không trùng.

Cách nào cũng được. Công cụ gì tiện lợi thì dùng.

Xin lỗi lần nữa là tôi cũng không biết nên post ở đây hay bên bài "Kỹ năng lập trình" mới đúng.

vodoi2x · 13/2/14

Đồng ý với VietMini: đây chỉ là 1 sub quá nhỏ, là 1 phần trong bài toán lớn, nếu quá xét nét (phải xét đến từng cột Dữ liệu chuẩn) thì có xét cả năm, cần phải nhớ đầy chỉ là 1 sub và lại đang cần test tốc độ thời gian nữa.

Với dữ liệu nhiều Bài này chưa hẳn Dictionary đã là lựa chọn tốt đâu Hoàng Trọng Nghĩa ah,

Nguyễn Duy Tuân đã viết:
Là do như các anh ở trên đã nói, thêm nữa là muốn các tác giả có nghiên cứu độc lập trong ví dụ này nên mới gửi bài riêng vào mail và công bố sau. Cũng chỉ còn 2 ngày nữa thôi nên vẫn theo như công bố ban đầu không vấn đề gì anh ạ. CÒn anh hay anh ptm muốn gửi code trực tiếp lên đây để mọi người xem và trao đổi luôn cũng được. Đặc biệt với giải pháp code VBA thuần túy, không sử dụng các công cụ hỗ trợ mạnh của Excel cũng là rất tốt cho người học VBA nắm rõ hơn về ngôn ngữ VBA.

Độc lập cũng là giải pháp hay, nhưng mọi người cứ đưa lên, đọc code người khác hiểu, và sáng tạo lại (dĩ nhiên có ghi chú rõ là trích ...) thì cũng là đáng quý, và dù sao cuộc thi cũng kết quả là chia sẻ, và cũng không có chi phải bí mật (hàng ngày vẫn giúp thành viên bài bày ra ngay còn được) - giờ open cùng được bàn thảo phải hay biết bao

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

vodoi2x đã viết:
Đồng ý với VietMini: đây chỉ là 1 sub quá nhỏ, là 1 phần trong bài toán lớn, nếu quá xét nét (phải xét đến từng cột Dữ liệu chuẩn) thì có xét cả năm, cần phải nhớ đầy chỉ là 1 sub và lại đang cần test tốc độ thời gian nữa.

Với dữ liệu nhiều Bài này chưa hẳn Dictionary đã là lựa chọn tốt đâu Hoàng Trọng Nghĩa ah,

Có thể là Dict chưa hẳn đã tốt, nhưng mình viết code chạy tương tự thì không nhanh hơn nó nên đành chọn nó vậy.

vodoi2x · 13/2/14

Hoàng Trọng Nghĩa đã viết:
Có thể là Dict chưa hẳn đã tốt, nhưng mình viết code chạy tương tự thì không nhanh hơn nó nên đành chọn nó vậy.

Tuy thế Giải pháp 1, up lên đây cũng là sử dụng Dictionary,

Tốc độ có cải thiện nhiều lần: thử trên laptop của tôi khoảng 330-340 mls cho chạy lần đầu, chạy từ lần 2 trở đi chỉ khoảng 230-240 mls

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)

Mong nhận được đóng góp

PHP:

Private Sub LapSo()
    ''Code lap so th nxt
    ''Su Dung Dictionary
    ''nguoi Lap: vodoi2x
    ''email: vodoi909090@yahoo.com
    
    Application.ScreenUpdating = False
    Dim DicH, arrRes(), soDM()
    Dim Day1 As Long, Day2 As Long, i As Long, k As Long, p As Long, c1 As Long, c2 As Long
    Static DicDM, Ngay(), MaSoHH(), SoLG(), LoaiPhieu(), ThanhTien()
    
    ''Nhap du lieu ngay 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 DicDM dung luu gia tri Key
    If Run1D Then
        p = DicDM.Count
    Else
        soDM = Range("DMVLSPHH").Offset(1).Resize(Range("DMVLSPHH").Rows.Count - 1, 3).Value2
        p = UBound(soDM)
        
        ''Khoi tao Dictionary DicDM luu giu Key la MaHH va Item la gia tri Ten, DVT trong sheet DM VLSPHH
        Set DicDM = CreateObject("Scripting.Dictionary")
        For i = 1 To p
            DicDM(soDM(i, 1)) = Array(soDM(i, 2), soDM(i, 3))
        Next i
        Run1D = True
    End If

    ReDim arrRes(1 To p + 10, 1 To 12) ''Mang chua ket qua gom 12 cot
    Set DicH = CreateObject("Scripting.Dictionary") '' khoi tao Dictionary DicH 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
            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
            
            If DicH.exists(MaSoHH(i, 1)) Then   ''Truong hop CO MaHH trong Dictionary DicH, nen ta lay vi tri va gan gia tri vao arrRes
                p = DicH.Item(MaSoHH(i, 1))
                arrRes(p, c1) = arrRes(p, c1) + SoLG(i, 1)
                arrRes(p, c2) = arrRes(p, c2) + ThanhTien(i, 1)
            Else                                ''Truong hop CHUA CO MaHH trong Dictionary DicH, nen ta cong vao, va gan gia tri vao arrRes
                k = k + 1
                DicH.Add MaSoHH(i, 1), k
                arrRes(k, 2) = MaSoHH(i, 1)
                arrRes(k, c1) = SoLG(i, 1)
                arrRes(k, c2) = ThanhTien(i, 1)
            End If
        End If
    Next 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
        If DicDM.exists(arrRes(i, 2)) Then
            arrRes(i, 3) = DicDM.Item(arrRes(i, 2))(0)
            arrRes(i, 4) = DicDM.Item(arrRes(i, 2))(1)
        End If
        arrRes(i, 11) = arrRes(i, 5) + arrRes(i, 7) - arrRes(i, 9)
        arrRes(i, 12) = arrRes(i, 6) + arrRes(i, 8) - arrRes(i, 10)
        
        arrRes(p, 6) = arrRes(p, 6) + arrRes(i, 6)
        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

cuối cùng cũng đã Upload file lên trực tiếp GPE

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

dhn46 · 13/2/14

Đọc bài anh Vodoi2x em vỡ ra một điều mà mình rất ít chú ý đó là biến tạm.

Khi dùng biến tạm trên Code của em thì thấy tốc độ tăng đáng kể mặc dù còn "Rùa" quá

vodoi2x · 13/2/14

dhn46 đã viết:
Đọc bài anh Vodoi2x em vỡ ra một điều mà mình rất ít chú ý đó là biến tạm.

Khi dùng biến tạm trên Code của em thì thấy tốc độ tăng đáng kể mặc dù còn "Rùa" quá

Và bạn nên chú ý: .Value2 thay vì chỉ .Value khi lấy dữ liệu, cũng như chỉ nhập những dữ liệu cần vào thay vì load kiểu gán mảng 2 chiều rộng (chứa các dữ liệu không cần, vì KHO có nhiều dòng, dẫn đến giảm tốc độ),

Cũng như cố gắng khai báo khai báo tường minh các biến, ví dụ như biến mảng thêm () sau tên biến

Cứ thử test sẽ thấy các điều đó

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

vodoi2x đã viết:
Và bạn nên chú ý: .Value2 thay vì chỉ .Value khi lấy dữ liệu, cũng như chỉ nhập những dữ liệu cần vào thay vì load kiểu gán mảng 2 chiều rộng (chứa các dữ liệu không cần, vì KHO có nhiều dòng, dẫn đến giảm tốc độ),

Cũng như cố gắng khai báo khai báo tường minh các biến, ví dụ như biến mảng thêm () sau tên biến

Cứ thử test sẽ thấy các điều đó

Hay lắm bạn vodoi2x, chỉ cần thay Value thành Value2 đã thấy tốc độ được cải thiện!

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.

vodoi2x · 14/2/14

ptm0412 đã viết:
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.

Là do chỗ này cứ lấn cấn việc đặt name KHO là có gồm dòng tiêu đề hay không có dòng tiêu đề đây, dẫn đến chỉnh đi chỉnh lại xót luôn (vì lo việc tổng độ có sao chăng , khi ta offset hay không nên offset)

Mã:

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

Hiện name KHO là bao hàm cả dòng tiêu đề (như chủ topic đặt từ đầu)
nên sửa thành như sau cho đúng đủ số dòng dữ liệu

Mã:

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

ptm0412 · 14/2/14

Tôi áp dụng 2 việc của vodoi2x vào code của tôi:
- Dùng Value2
- Dùng 5 mảng data nguồn 1 cột thay vì 1 mảng 11 cột
- Giữ nguyên thuật toán (sửa 2 biến Date đều thành Long, cho khỏi ngộ ngộ.)

Sau đó so với code của vodoi2x "Dictionary only" bài mới nhất #156, thấy code của tôi luôn nhanh hơn code vodoi2x của lần chạy đầu tiên.
phương pháp test:
- Code vodoi2x: Xóa những gì liên quan đến 2 biến Run1K và Run1D, xem như không dùng đến dữ liệu đang lưu trữ, mỗi lần chạy là mỗi lần nạp, và chạy 10 lần lấy trung bình.
- Code của tôi cũng chạy 10 lần lấy trung bình
- Đóng excel, test lại 10 lần nữa.

Code:

PHP:

Sub LapSo()
    Application.ScreenUpdating = False
    Dim ListArr(), sArrID(), TmpArr(), RArr(), sArrQty(), sArrAmt(), sArrDocType(), sArrDate()
    Dim Dic1 As Object, 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
    Set Dic1 = CreateObject("Scripting.Dictionary")
    ''Lay danh muc vao mang
    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
    ''Xác dinh dong cuoi cua data va nap vao mang
    With Sheet20
    EndR = .Cells(4, 1).End(xlDown).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
            ' 'Xac dinh dong chua ma HH trong danh muc, gan vao cot 1 cua KQ tam
            j = Dic1.Item(sArrID(i, 1))
            TmpArr(j, 1) = j
        ''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
            RArr(k, 2) = ListArr(i, 1)
            RArr(k, 3) = ListArr(i, 2)
            RArr(k, 4) = ListArr(i, 3)
            ''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 Dic1 = Nothing
Application.ScreenUpdating = True
End Sub

ptm0412 · 15/2/14

vodoi2x đã viết:
Là do chỗ này cứ lấn cấn việc đặt name KHO là có gồm dòng tiêu đề hay không có dòng tiêu đề đây, dẫn đến chỉnh đi chỉnh lại xót luôn (vì lo việc tổng độ có sao chăng , khi ta offset hay không nên offset)

Chính vì không muốn offset và resize nhiều, do Name đã đặt bao gồm tiêu đề, nên tôi không dùng cái name nào. Chỉ tìm dòng cuối chứa dữ liệu và gán vào mảng. kể cả mảng danh mục.

Hai Lúa Miền Tây · 15/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.

Đúng là bài toán này dùng ADO là gọn và uyển chuyển nhất, tuy nhiên tốc độ so với những cách khác ở trên thì rất hạn chế. Cách ADO so với cách của anh vodoi2x thì ADO sẽ cho thời gian chậm hơn gấp 20 lần. Topic này đưa ra nhằm tìm cách giải quyết với thời gian nhanh nhất. Xét thấy ADO không có được ưu điểm về tốc độ cho bài toán này nên em đành theo dõi và học hỏi thêm từ những cách khác.

vodoi2x · 15/2/14

ptm0412 đã viết:
Chính vì không muốn offset và resize nhiều, do Name đã đặt bao gồm tiêu đề, nên tôi không dùng cái name nào. Chỉ tìm dòng cuối chứa dữ liệu và gán vào mảng. kể cả mảng danh mục.

Offset resize, không làm giảm tốc độ đáng kể đâu ah,

ptm0412 đã viết:
Tôi áp dụng 2 việc của vodoi2x vào code của tôi:
- Dùng Value2
- Dùng 5 mảng data nguồn 1 cột thay vì 1 mảng 11 cột
- Giữ nguyên thuật toán (sửa 2 biến Date đều thành Long, cho khỏi ngộ ngộ.)

Sau đó so với code của vodoi2x "Dictionary only" bài mới nhất #156, thấy code của tôi luôn nhanh hơn code vodoi2x của lần chạy đầu tiên.
phương pháp test:
- Code vodoi2x: Xóa những gì liên quan đến 2 biến Run1K và Run1D, xem như không dùng đến dữ liệu đang lưu trữ, mỗi lần chạy là mỗi lần nạp, và chạy 10 lần lấy trung bình.
- Code của tôi cũng chạy 10 lần lấy trung bình
- Đóng excel, test lại 10 lần nữa.

đúng là giờ nhanh hơn rùi, nhờ chỉ sử dụng 1 Dictionary - và qua đó thấy vai trò của .Value2 cũng như Không đọc dữ liệu dư sẽ tăng tốc độ đáng kể trong bài toán topic này

Tuy vậy, PTM xem bổ sung việc lỗi xảy ra khi - Mã hàng không tồn tại trong "bảng danh mục" (sheet DM VLSPHH) nhưng lại có trong KHO

Vì dụ giờ ta có mã hàng mới là HH099 xuất hiện trong kho --> khi đó chương trình có lỗi -

VỚi đúng cơ sở DL này thì thuật toán này tốt đã giảm đi 1 DIC,

Tôi sẽ chuyển bài này của PTM sang sử dụng collection --> xem tốc độ thế nào có khi lại hay hơn phiên bản collection của tôi,

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

vodoi2x đã viết:
...
Tuy vậy, PTM xem bổ sung việc lỗi xảy ra khi - Mã hàng không tồn tại trong "bảng danh mục" (sheet DM VLSPHH) nhưng lại có trong KHO

Vì dụ giờ ta có mã hàng mới là HH099 xuất hiện trong kho --> khi đó chương trình có lỗi -
...

Nếu dùng ADO thì xử lý cái này rất đơn giản.

vodoi2x · 15/2/14

vodoi2x đã viết:
Tôi sẽ chuyển bài này của PTM sang sử dụng collection --> xem tốc độ thế nào có khi lại hay hơn phiên bản collection của tôi,

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 đây, và cũng đã sửa lỗi

Tuy vậy, PTM xem bổ sung việc lỗi xảy ra khi - Mã hàng không tồn tại trong "bảng danh mục" (sheet DM VLSPHH) nhưng lại có trong KHO

Vì dụ giờ ta có mã hàng mới là HH099 xuất hiện trong kho --> khi đó chương trình có lỗi -

code chuyển sang collection từ code gốc PTM bài 162

PHP:

Sub LapSo()
    ''Code goc from PTM0412 sd Dictionary
    ''vodoi2x chinh sua , sua loi va chuyen sang collection 15.02.2014

    Application.ScreenUpdating = False
    Dim ListArr(), sArrID(), TmpArr(), RArr(), sArrQty(), sArrAmt(), sArrDocType(), sArrDate()
    Dim ColDM As Collection, 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
    On Error Resume Next
    For i = 1 To ListCt
        ColDM.Add Item:=i, Key:=ListArr(i, 1)
    Next
    On Error GoTo 0
    
    ''Xác dinh dong cuoi cua data va nap vao mang
    With Sheet20
    EndR = .Cells(4, 1).End(xlDown).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 + 10, 1 To 7) ''10 so du phong Ma hang khong co trong danh muc
    Date1 = Sheet3.[B1]
    Date2 = Sheet3.[B2]
    Dim uB As Long
    uB = ListCt
    ''Duyet mang Data
    For i = 1 To DataCt
        If sArrDate(i, 1) <= Date2 Then
            ' 'Xac dinh dong chua ma HH trong danh muc, gan vao cot 1 cua KQ tam
            On Error Resume Next
            j = ColDM.Item(sArrID(i, 1))
            If Err.Number <> 0 Then
                On Error GoTo 0
                uB = uB + 1
                j = uB
                ColDM.Add Item:=j, Key:=sArrID(i, 1)
            Else
                On Error GoTo 0
            End If
            
            TmpArr(j, 1) = sArrID(i, 1) ''j
        ''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
        Else   ''If 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
      End If
    ''Ket thuc vong lap, Mang KQ tam co 12 dong
    Next
    ''Khai bao  Mang KQua
    ReDim RArr(1 To uB, 1 To 12)
    k = 0
    ''Duyet mang KQ tam
    For i = 1 To uB
            ''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
    
    ''With Sheet26.[B12].Offset(k)
    ''    Union(.Offset(, 5), .Offset(, 7), .Offset(, 9), .Offset(, 11)).Formula = "=SUM(R[-" & k & "]C:R[-1]C)"
    ''End With
    
Set ColDM = Nothing
Application.ScreenUpdating = True
End Sub

(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)

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

vodoi2x đã viết:

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 đây, và cũng đã sửa lỗi

code chuyển sang collection từ code gốc PTM bài 162

PHP:

Sub LapSo()
    ''Code goc from PTM0412 sd Dictionary
    ''vodoi2x chinh sua , sua loi va chuyen sang collection 15.02.2014

    Application.ScreenUpdating = False
    Dim ListArr(), sArrID(), TmpArr(), RArr(), sArrQty(), sArrAmt(), sArrDocType(), sArrDate()
    Dim ColDM As Collection, 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
    On Error Resume Next
    For i = 1 To ListCt
        ColDM.Add Item:=i, Key:=ListArr(i, 1)
    Next
    On Error GoTo 0
    
    ''Xác dinh dong cuoi cua data va nap vao mang
    With Sheet20
    EndR = .Cells(4, 1).End(xlDown).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 + 10, 1 To 7) '10 so du phong Ma hang khong co trong danh muc
    Date1 = Sheet3.[B1]
    Date2 = Sheet3.[B2]
    Dim uB As Long
    uB = ListCt
    ''Duyet mang Data
    For i = 1 To DataCt
        If sArrDate(i, 1) <= Date2 Then
            ' 'Xac dinh dong chua ma HH trong danh muc, gan vao cot 1 cua KQ tam
            On Error Resume Next
            j = ColDM.Item(sArrID(i, 1))
            If Err.Number <> 0 Then
                On Error GoTo 0
                uB = uB + 1
                j = uB
                ColDM.Add Item:=j, Key:=sArrID(i, 1)
            Else
                On Error GoTo 0
            End If
            
            TmpArr(j, 1) = sArrID(i, 1) 'j
        ''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
        Else   ''If 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
      End If
    ''Ket thuc vong lap, Mang KQ tam co 12 dong
    Next
    ''Khai bao  Mang KQua
    ReDim RArr(1 To uB, 1 To 12)
    k = 0
    ''Duyet mang KQ tam
    For i = 1 To uB
            ''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
    
    'With Sheet26.[B12].Offset(k)
    '    Union(.Offset(, 5), .Offset(, 7), .Offset(, 9), .Offset(, 11)).Formula = "=SUM(R[-" & k & "]C:R[-1]C)"
    'End With
    
Set ColDM = Nothing
Application.ScreenUpdating = True
End Sub

(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)

Máy em chạy lỗi Run-time error '13' tại dòng

ColDM.Add Item:=j, Key:=sArrID(i, 1)

vodoi2x · 15/2/14

Hai Lúa Miền Tây đã viết:
Máy em chạy lỗi Run-time error '13' tại dòng

Vậy thử down file sau về thử xem có còn bị lỗi đó không?

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

Thử với Collection!

Thay vì dùng Dictionary, tôi dùng Collection để thay thế (bài tôi gửi Anh Tuân tôi dùng Dictionary).

Mã:

[COLOR=#0000ff]Function [/COLOR][COLOR=#008000]Exists[/COLOR][COLOR=#0000ff](ByRef Collect As [/COLOR][COLOR=#ff0000]Collection[/COLOR][COLOR=#0000ff], ByVal sKey As String) As Boolean[/COLOR]
[COLOR=#0000ff]    Dim lCheck As Long[/COLOR]
[COLOR=#0000ff]    On Error Resume Next[/COLOR]
[COLOR=#0000ff]    lCheck = VarType(Collect.Item(sKey))[/COLOR]
[COLOR=#0000ff]    If Err.Number = 0 Then[/COLOR]
[COLOR=#0000ff]        Exists = True[/COLOR]
[COLOR=#0000ff]    Else[/COLOR]
[COLOR=#0000ff]        Exists = False[/COLOR]
[COLOR=#0000ff]    End If[/COLOR]
[COLOR=#0000ff]End Function[/COLOR]

[GPECODE=vb]

Sub LapSo()
Static ArrData, LastRow 'moi cap nhat
If Not IsArray(ArrData) Then
Dim RowCount 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 + 1
Else
LastRow = RowCount
End If
''Luong truoc kha nang du lieu tai KHO chua nhap du lieu:
If LastRow - 1 <= 3 Then
MsgBox "Tai sheet 'KHO' chua co du lieu nao!"
Exit Sub
End If
''Nen gan array bang mang 1 chieu theo cot vi vay no
''se xu ly rat nhanh (mau chot cua van de nhanh cham),
''uu diem cua no la ban co the sap xep vi tri cot ngay tu dau:
ReDim ArrData(1 To 5)
With Sheets("KHO").Range("B4:B" & LastRow)
ArrData(1) = .Offset(, 5) 'MA_VLSPHH
ArrData(2) = .Offset(, 6) 'SLG
ArrData(3) = .Offset(, 9) 'THANH_TIEN
ArrData(4) = .Offset(, 8) 'LOAI_PHIEU
ArrData(5) = .Value 'NGAY_CT
End With
End If
''Nen dat cac bien sau Exit Sub de khoi phai giai phong bien:
Dim Collect As New Collection
Dim c As Long, r As Long, n As Long
Dim IDProductColumn As Range, IDProduct As Range
Dim ArrReport(), ArrToTal(3 To 12)
Dim CondDate As Date, FromDate As Date, ToDate As Date
''Nhan gia tri ngay tai sheet SETTING:
FromDate = Range("NGAY1").Value
ToDate = Range("NGAY2").Value
''Tieu de cho hang TONG CONG:
ArrToTal(3) = "T" & ChrW(7892) & "NG C" & ChrW(7896) & "NG:"
''Tao san cot MaSanPham de phuc vu cho Find method:
Set IDProductColumn = Range(Sheets("DM VLSPHH").Range("A3"), Sheets("DM VLSPHH").Range("A" & LastRow).End(xlUp))
Dim ItmID As String
Dim Index As Long, m As Long
Dim General(), GetID(), Balance_In_Out(1 To 3), Quantity_Amount(1 To 2)
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)
If ItmID = "" Or CondDate > ToDate Then GoTo NextR
If Exists(Collect, ItmID) Then
''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
Else
n = n + 1
ReDim Preserve GetID(1 To n), General(1 To n)
Collect.Add n, ItmID
GetID(n) = ItmID
If CondDate < FromDate Then
If ArrData(4)(r, 1) = "N" Then
Quantity_Amount(1) = ArrData(2)(r, 1) 'SLG
Quantity_Amount(2) = ArrData(3)(r, 1) 'THANH_TIEN
Else
Quantity_Amount(1) = -ArrData(2)(r, 1) 'SLG
Quantity_Amount(2) = -ArrData(3)(r, 1) 'THANH_TIEN
End If
''Gan phan tu nay,
Balance_In_Out(1) = Quantity_Amount
''nhung khong the bo qua buoc duoi nay,
''neu khong se bi loi type mismatch(13)
''khi Exists=True hoat dong:
Quantity_Amount(1) = Empty
Quantity_Amount(2) = Empty
Balance_In_Out(2) = Quantity_Amount
Balance_In_Out(3) = Quantity_Amount
ElseIf CondDate <= ToDate Then
Quantity_Amount(1) = ArrData(2)(r, 1) 'SLG
Quantity_Amount(2) = ArrData(3)(r, 1) 'THANH_TIEN
If ArrData(4)(r, 1) = "N" Then
Balance_In_Out(2) = Quantity_Amount
Quantity_Amount(1) = Empty
Quantity_Amount(2) = Empty
Balance_In_Out(1) = Quantity_Amount
Balance_In_Out(3) = Quantity_Amount
Else
Balance_In_Out(3) = Quantity_Amount
Quantity_Amount(1) = Empty
Quantity_Amount(2) = Empty
Balance_In_Out(1) = Quantity_Amount
Balance_In_Out(2) = Quantity_Amount
End If
End If
''Array 'General' nhan cac array trong array:
General(n) = Balance_In_Out
End If
NextR:
Next
Dim x As Byte, y As Byte, z As Byte
''Xu ly mang cuoi cung de xuat du lieu ra sheet:
ReDim ArrReport(1 To n, 1 To 12)
For r = 1 To n
ArrReport(r, 1) = r 'STT
ArrReport(r, 2) = GetID(r) 'MA
''Tim trong sheet DM VLSPHH de gan ten va don vi tinh:
Set IDProduct = IDProductColumn.Find(What:=GetID(r), LookIn:=xlFormulas, LookAt:=xlWhole)
If Not IDProduct Is Nothing Then
ArrReport(r, 3) = IDProduct.Offset(, 1) 'TEN
ArrReport(r, 4) = IDProduct.Offset(, 2) 'DVT
End If
ArrReport(r, 5) = General(r)(1)(1) 'SL_TON
ArrReport(r, 6) = General(r)(1)(2) 'TT_TON
ArrReport(r, 7) = General(r)(2)(1) 'SL_NHAP
ArrReport(r, 8) = General(r)(2)(2) 'TT_NHAP
ArrReport(r, 9) = General(r)(3)(1) 'SL_XUAT
ArrReport(r, 10) = General(r)(3)(2) 'TT_XUAT
ArrReport(r, 11) = ArrReport(r, 5) + ArrReport(r, 7) - ArrReport(r, 9) 'SL_TONCUOI
ArrReport(r, 12) = ArrReport(r, 6) + ArrReport(r, 8) - ArrReport(r, 10) 'TT_TONCUOI
''Dung cho viec total:
For c = 5 To 12
ArrToTal(c) = ArrToTal(c) + ArrReport(r, c)
Next
Next
''Xoa noi dung bieu mau cua sheet THNXT.
''Nen co dinh truoc bieu mau co so hang
''khong thay doi, se xu ly sau neu so hang phat sinh:
Sheets("THNXT").Range("B12:M24").ClearContents
''Le ra phai co che do 'co-gian' bieu mau, neu n > 13 thi
''phai xu ly bieu mau truoc khi gan array vao:
Sheets("THNXT").Range("B12").Resize(n, 12) = ArrReport
''Neu xu ly thi nen dat mot name tai ô có chu CONG,
''Boi khi insert hay delete hang name deu chay theo!
''Tam thoi gan theo dia chi co dinh:
Sheets("THNXT").Range("D24:M24") = ArrToTal
End Sub[/GPECODE]

ptm0412 đã viết:
- Dùng 5 mảng data nguồn 1 cột thay vì 1 mảng 11 cột
- Giữ nguyên thuật toán (sửa 2 biến Date đều thành Long, cho khỏi ngộ ngộ.)

Cái vụ màu đỏ em đã sử dụng từ rất lâu rồi ạ và thuật toán Mảng trong Mảng cũng thú vị và rất nhanh đấy Sư phụ ạ. Riêng cái Collection (có thể nó có ở đâu đó trên diễn đàn mà tôi chưa thấy) thì mới biết từ bài của Vodoi2x (trước đây học lóm của Thầy ndu96081631 chiêu Dictionary). Cám ơn Vodoi2x nhé! Giờ thì mình có thể học lóm thêm chiêu này!

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

mình không biết nhiều về code nên chỉ ăn gian thôi .ec --=0

ec

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

Lê Duy Thương đã viết:
mình không biết nhiều về code nên chỉ ăn gian thôi .ec ec

Nếu code khai báo biến với Static hoặc Public thì người ta cũng ăn gian ở các lần sau như cậu thôi, bởi lần đầu code cậu tạo Pivot, lần sau cậu đã có nó và thực hiện lệnh copy (cái này cậu ăn gian hơn tí hihihi)!

---------------------------------------------------------------------
Test với Dictionary và Collection thì trên máy tính của tôi Dict vẫn nhanh hơn Coll với vòng lặp 300.000 lần, nhưng nếu hơn nữa thì thằng Coll chạy ăn đứt thằng Dict!

Mã:

Sub DictTest()
    Dim i As Long
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
    For i = 1 To 300000
        Dict.Add "Nghia" & i, i
    Next
End Sub


Sub CollTest()
    Dim i As Long
    Dim Collect As New Collection
    For i = 1 To 300000
        Collect.Add i, "Nghia" & i
    Next
End Sub

------------------------------------------------------------------
Đúng như tôi nghĩ, Collection đã được admin levanduyet giới thiệu tại đây:

http://www.giaiphapexcel.com/forum/...y-các-giá-trị-không-trùng&p=235231#post235231

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

Hoàng Trọng Nghĩa đã viết:
Nếu code khai báo biến với Static hoặc Public thì người ta cũng ăn gian ở các lần sau như cậu thôi, bởi lần đầu code cậu tạo Pivot, lần sau cậu đã có nó và thực hiện lệnh copy (cái này cậu ăn gian hơn tí hihihi)!

---------------------------------------------------------------------
Test với Dictionary và Collection thì trên máy tính của tôi Dict vẫn nhanh hơn Coll, nhưng nếu hơn nữa thì thằng Coll chạy ăn đứt thằng Dict!

Mã:

Sub DictTest() Dim i As Long Dim Dict As Object Set Dict = CreateObject("Scripting.Dictionary") For i = 1 To 300000 Dict.Add "Nghia" & i, i Next End Sub Sub CollTest() Dim i As Long Dim Collect As New Collection For i = 1 To 300000 Collect.Add i, "Nghia" & i Next End Sub

------------------------------------------------------------------
Đúng như tôi nghĩ, Collection đã được admin levanduyet giới thiệu tại đây:

http://www.giaiphapexcel.com/forum/...y-các-giá-trị-không-trùng&p=235231#post235231

nếu dữ liệu it thì dic nhanh hơn, dữ liệu nhiều thì collection nhanh hơn
trước đây tôi cũng có sử dụng 1 lần vọc collection.để lọc duy nhất.nhưng ko nhanh bằng dictionary
http://www.giaiphapexcel.com/forum/...lọc-duy-nhất-từ-danh-sách&p=524518#post524518

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

Tôi ngồi ngẫm nghĩ và nghiệm ra như thế này, với biến mảng động, thay vì ta khai báo với Static trong thủ tục:

Mã:

Sub TestStatic()
    [COLOR=#ff0000][B]Static [/B][/COLOR]ArrData
    If Not IsArray(ArrData) Then
        '....
    End If
End Sub

Thì ta nên thực hiện biến này với khai báo là Public:

Mã:

[COLOR=#0000ff][B]Public [/B][/COLOR]ArrData


Sub TestPublic()
    If Not IsArray(ArrData) Then
        '....
    End If
End Sub

Một lý do hết sức đơn giản là, khi dữ liệu mà mảng ArrData được gán thay đổi, cụ thể trong bài này là sheet KHO vì lý do gì đó nhập thêm hay bớt ra (thông thường cơ sở dữ liệu người ta thường nhập trên Form) thì ta chỉ việc dùng thủ tục này để giải phóng biến, thay vì dùng biến Boolean để check (dư ra biến Boolean này):

Mã:

Sub ClearVariable()
    [COLOR=#008000][B]ArrData = Null[/B][/COLOR]
End Sub

Mặc dù bài mà Anh Nguyễn Duy Tuân đưa ra tương đối dễ, nhưng học hỏi và suy luận được rất nhiều thứ!

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

Tổng kết cuộc thi viết code đạt tốc độ nhanh nhất sổ tổng hợp nhập xuất tồn

Tổng kết cuộc thi viết code đạt tốc độ nhanh nhất bài lập sổ tổng hợp nhập xuất tồn trong VBA.
Cuộc thi phát động vào sáng ngày 10-02-2014, hạn cuối gửi bài 12hAM ngày 15/02/2014.

Qua 6 ngày vừa qua có thể thấy có rất nhiều thành viên quan tâm và được thể hiện qua lượng người xem > 3000. Được các thành viên có kinh nghiệm tốt về VBA đã nhiệt tình tham gia trao đổi, gửi bài như: SA_DQ, HYen17, ChanhTQ@, Ba Tê, Hoàng Trọng Nghĩa, Lê Duy Thương, Hai Lúa Miền Tây, ptm0412, dhn46, Nguyễn Duy Tuân, Vodoi2x.

Việc đánh giá các bài gửi bằng phương pháp như sau

1. Tất cả phải chạy trên cùng một máy tính
2. Tắt tất cả các ứng dụng đang chạy, các chương trình thường trú cũng tắt đi nếu không liên quan đến Windows để giảm những tác động đến Windows và Excel.
3. Một bài thi phải được test theo quy trình như sau
b1. Tắt Excel (nếu đang mở)->Mở Excel -->đảm bảo môi trường "sạch"
b2. Mở file Excel cần đo thời gian. Hãy đợi một lúc đảm bảo Excel đã thực hiện các công việc của nó xong. Hãy nhấn CTRL+ALT+DEL để mở "Task Manager", trong tab "Processes" đảm bảo dòng có EXCEL.EXE, CPU và Memory đang ở con số ổn định (không thay đổi liên tục).
Sửa lại thủ tục "DoThoiGian" để tự tính trung bình 3 lần chạy như sau:
[GPECODE=vb]
Sub DoThoiGian()
Dim T1@, T2@, Freq@, Overhead@, I&, T(2)
QueryPerformanceFrequency Freq
QueryPerformanceCounter T1
QueryPerformanceCounter T2
Overhead = T2 - T1
Debug.Print ActiveWorkbook.Name
For I = 0 To 2
QueryPerformanceCounter T1

'Thu tuc cua ban

LapSo 'Thu tuc ban phai lam

'Ket thuc chay thu tuc, nhan thoi gian ket thuc
QueryPerformanceCounter T2
T(I) = Round((T2 - T1 - Overhead) / Freq * 1000, 0)
Debug.Print "Lan " & I + 1, T(I); "milliseconds(ms)"
Next I
Debug.Print "Toc do trung binh: "; Round((T(0) + T(1) + T(2)) / 3, 0); "milliseconds(ms)"
MsgBox "Toc do trung binh: " & Round((T(0) + T(1) + T(2)) / 3, 0) & " milliseconds(ms)", vbInformation, "Code da duoc chay 3 lan"
End Sub
[/GPECODE]
b3. Nhấn nút "Thực Hiện" tại sheet "THNXT" và ghi nhận thời gian thực hiện.

Đến code của bài dự thi khác lại lập lại từ b1.

Kết quả do tôi test như sau.
Cấu hình phần cứng và phần mềm của máy tính test

Microsoft Excel 2010 Professional Plus 32-bit.

Kết quả thu được như sau:

Với kết quả trên chúng ta thấy ngay anh Vodoi2x là người có code chạy nhanh nhất với ví dụ dùng Collection, tốc độ đạt 250 mili giây. Xin cảm ơn và chúc mừng anh.

Đánh giá chung các bài của các tác giả:
Tất cả các bài thi tốc độ đều < 1000 mili giây vì vậy đều có thể được coi tốc độ nhanh.
Các tác giả Ba Tê, Hoàng Trọng Nghĩa, dhn46 dùng Array và Dictionary để nạp danh sách duy nhất. Tốc độ khá nhanh, chêch lệch nhau không nhiều.
Bác HYen17 thì viết VBA kết hợp với hàm Excel là SumIf chạy cũng rất nhanh, tuy nhiên các thành viên chờ bác sửa lại code về mã danh mục thì không thấy bác viết tiếp. Hy vọng bác bổ sung tiếp trong topic này.
Anh Lê Duy Thương dùng Pivot cũng rất tốt. Tuy nhiên để đánh giá ký chút ta phải tính cả lúc tạo Pivot. Nếu trong thực tế sử dụng ta chỉ phải tạo Pivot nếu chưa từng tạo nó còn lần thứ 2 trở đi không phải tạo thì Pivot có lẽ là tốc độ nhanh nhất. Nếu nếu file Excel lưu Pivot các bạn nên chú ý tới dung lượng của file, tốc độ mở file Excel vì có thể sẽ nặng và chậm.
Anh Vodoi2x đã đưa cả 2 cách Dictionary và Collection kết hợp với Array. Ví dụ Dictionary tốc độ cũng không bằng Collection. Xem qua thì hình như code trong ví dụ Collection có giải thuật khác? Cá nhân em đánh giá với yêu cầu ví dụ này thì nếu chỉ là Collection thì nó không phải yếu tố làm cho code chạy nhanh? Các yếu tố quyết định làm cho code của anh Vodoi2x chạy nhanh nhất chính là chuyển dùng Value2 thay cho Value, chuyển Range.Value2 sang array, array đóng vai trò là nguồn dữ liệu, được dùng để phân tích và tính toán trong vòng lặp.

Bài của tôi - Nguyễn Duy Tuân đã gửi trang đầu đạt tốc độ thấp nhất (hơn 2000 mili giây). Đạt giải khuyến khích //////

. Tuy nhiên sau khi lấy kinh nghiệm bài anh Vodoi2x chuyển Range sang Array làm nguồn, Value->Value2, giữ nguyên thuật toán tốc độ đạt 299 mili giây (kém 50 mili giây so với bài Vodoi2x). Điều đặc biệt trong code của tôi chỉ dùng Array (không dùng Dictionary, Collection). Tôi đang nghi ngờ rằng, code của anh Vodoi2x nhanh hơn của tôi là do thuật toán hoán đổi mảng chứ không phải do dùng Collection?

Nhiều người đã thí nghiệm Collection nhanh hơn Dictionary nên tôi lấy Collection so sánh với Array với bài test: nạp danh sách, kiểm tra mã tồn tài và nạp tiếp.
[GPECODE=vb]
Sub DoThoiGianColl_Array()
Dim T1@, T2@, Freq@, Overhead@
Dim TimeColl, TimeArray
QueryPerformanceFrequency Freq
QueryPerformanceCounter T1
QueryPerformanceCounter T2
Overhead = T2 - T1
'Debug.Print "Test Collection"
QueryPerformanceCounter T1
TestCollection 'Thu tuc ban phai lam
QueryPerformanceCounter T2
TimeColl = (T2 - T1 - Overhead) / Freq * 1000 '; "milliseconds(ms)"
'Test Array
'Debug.Print "Test Array"
QueryPerformanceCounter T1
TestArray 'Thu tuc ban phai lam
QueryPerformanceCounter T2
TimeArray = (T2 - T1 - Overhead) / Freq * 1000 '; "milliseconds(ms)"
'Ket thuc chay thu tuc, nhan thoi gian ket thuc
MsgBox "Toc do cua Collection & Array trong viec them phan tu va kiem tra su ton tai cua phan tu: " & Chr(13) & _
"Collection: " & Round(TimeColl, 0) & Chr(13) & _
"Array: " & Round(TimeArray, 0), vbInformation, "Don vi do milliseconds(ms)"
End Sub

Sub TestCollection()
Dim Coll As New Collection
Dim I&, Item
For I = 1 To 50000
Coll.Add CStr(I), CStr(I)
Next I
For I = 1 To 100
Item = "25000"
If Not CollExist(Item, Coll) Then
Coll.Add Item, Item
End If
Next I
Set Coll = Nothing
End Sub

Function CollExist(Item, Colls As Collection) As Boolean
On Error GoTo lbEndFunc
Colls.Item (Item)
CollExist = True
Exit Function
lbEndFunc:
CollExist = False
End Function

Sub TestArray()
Dim Coll()
Dim I&, Item
For I = 1 To 50000
ReDim Preserve Coll(I - 1)
Coll(I - 1) = CStr(I)
Next I
For I = 1 To 100
Item = "25000"
If Not ItemExists(Item, Coll) Then
ReDim Preserve Coll(I - 1)
Coll(I - 1) = CStr(I)
End If
Next I
End Sub
'Ham kiem tra doi tuong co trong mang hay khong
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
[/GPECODE]

Chạy thủ tục "DoThoiGianColl_Array" thì thấy Collection: 667, Array: 107. Vậy Array nhanh hơn Collection rất nhiều. Với bài toán mà yêu cầu nạp danh sách duy nhất thì ta nên dùng Array thuần túy là được rồi. Việc kiểm tra Item có tồn tại trong danh sách hay không ta tự viết tốc độ sẽ nhanh hơn ở vấn đề như sau. Nếu danh sách Mã hàng hóa trong sổ KHO sắp xếp tăng dần khi đó các mã nạp trong mảng có danh sách duy nhất cũng tăng dần. Vậy khi kiểm tra một mã theo thứ tự trong sổ KHO, hàm ItemExists tìm từ dưới lên trên nó sẽ thấy ngay bới 1 đến 2 vòng. Nếu theo kiểm tra ngầm định các hàm Dictionary.Exists() nếu tìm từ trên xuống dưới, khi số mã hàng nhiều việc tìm kiếm sẽ lâu hơn.

Trên là bài test cũng như những đánh giá của riêng cá nhân tôi nên có thể chưa phải đã tuyệt đối chính xác. Các thành viên có thể trao đổi làm rõ thêm tại topic này. Thêm nữa là các tác giả đã gửi bài bằng file hoặc code tại topic này có thể gửi lại code "LapSo" và các hàm, thủ tục của mình lên đây kèm theo những comment thật chi tiết và rõ ràng để các thành viên có điều kiện học tập.
Thông qua topic viết VBA tốc độ tối ưu này rõ ràng chúng ta được học lẫn nhau bởi các phương pháp đa dạng, tăng kiến thức VBA. Các thành viên GPE có nguồn thư viện để học tập, vận dụng cho bài toán thực tế. Các thành viên tham gia trao đổi và gửi bài phần lới đều có kinh nghiệm, kiến thức tốt về VBA, không ngại việc thắng thua, không dị ứng với từ "THI" mà theo đúng với tinh thần của topic này là giao lưu học hỏi lẫn nhau, các anh đúng là các người thầy thực sự của rất nhiều thành viên GPE về kiến thức, tinh thần học học và chia sẻ.

Dưới đây là toàn bộ mã nguồn của các tác giả gửi. Các thành viên nên download tất cả để tìm hiểu các phương pháp khác nhau. Các thành viên hãy bấm nút "Thanks" như một sự động viên và khuyến khích các tác giả tiếp tục đóng góp cho chúng ta nhé!

dhn46 · 16/2/14

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)

Mã:

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

ptm0412 · 16/2/14

Xem sơ code của dhn thì thấy tồn đầu chỉ tính cộng nhập mà không trừ xuất. Như vậy, nếu trước ngày bắt đầu không phải 1/8 mà là 1/9, thì số dư đầu bao gồm cả nhập và xuất trước ngày FDate, nhưng toàn là cộng chứ không trừ. Dẫn đến tồn đầu sai.

Thứ hai, DicData lấy trong dữ liệu và phải kiểm tra sự tồn tại 65.000 lần. Nên biết rằng 1 lần kiểm tra sự tồn tại tức là 1 thao tác phải tính thời gian. Nhân lên 65000 lần sẽ ra 1 con số đáng kể. Code của tôi chỉ 1 Dic lấy từ danh mục, và khi duyệt Data. chỉ truy xuất chứ không kiểm tra nữa.

Sau đó, để loại trừ các mặt hàng không tồn cũng không nhập xuất, tôi phải kiểm tra, nhưng lần này chỉ kiểm tra bằng vòng lặp 12 vòng. Giả sử không phải 12, cũng chắc chắn là ít hơn 65.000 mặt hàng.

ptm0412 · 16/2/14

vodoi2x đã viết:
Tuy vậy, PTM xem bổ sung việc lỗi xảy ra khi - Mã hàng không tồn tại trong "bảng danh mục" (sheet DM VLSPHH) nhưng lại có trong KHO
Vì dụ giờ ta có mã hàng mới là HH099 xuất hiện trong kho --> khi đó chương trình có lỗi -

Đối với việc quản lý kho hàng thì thông thường người ta đã bắt lỗi ngay khi nhập xuất 1 mặt hàng không có trong danh mục. Do đó tôi viết code dựa vào cơ sở không có việc chưa có mặt hàng đã mua bán. Vả lại, nếu có trường hợp này xảy ra thì sẽ chỉ có mã mà không có tên và đơn vị tính tương ứng, vì cấu trúc Data không có.

Hoàng Trọng Nghĩa đã viết:
Cái vụ màu đỏ em đã sử dụng từ rất lâu rồi ạ và thuật toán Mảng trong Mảng cũng thú vị và rất nhanh đấy Sư phụ ạ. Riêng cái Collection (có thể nó có ở đâu đó trên diễn đàn mà tôi chưa thấy) thì mới biết từ bài của Vodoi2x

Mảng trong mảng không phải là thuật toán mà chỉ là thủ thuật (phương tiện) để thực hiện thuật toán mà thôi. Ngoài ra, nó có thể thú vị, nhưng không nhanh. Mới cách đây mấy ngày Nghĩa nói chậm, hôm nay lại nói nhanh là sao?

Gởi Tuân,

Tuân test hộ code tôi đưa lên lần 2 ở bài #262 xem có phải trung bình 270 khô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.

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

ptm0412 đã viết:

Tôi áp dụng 2 việc của vodoi2x vào code của tôi:
- Dùng Value2
- Dùng 5 mảng data nguồn 1 cột thay vì 1 mảng 11 cột
- Giữ nguyên thuật toán (sửa 2 biến Date đều thành Long, cho khỏi ngộ ngộ.)

Sau đó so với code của vodoi2x "Dictionary only" bài mới nhất #156, thấy code của tôi luôn nhanh hơn code vodoi2x của lần chạy đầu tiên.
phương pháp test:
Code:

PHP:

Sub LapSo()
    Application.ScreenUpdating = False
    Dim ListArr(), sArrID(), TmpArr(), RArr(), sArrQty(), sArrAmt(), sArrDocType(), sArrDate()
    Dim Dic1 As Object, 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
    Set Dic1 = CreateObject("Scripting.Dictionary")
    ''Lay danh muc vao mang
    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
    ''Xác dinh dong cuoi cua data va nap vao mang
    With Sheet20
    EndR = .Cells(4, 1).End(xlDown).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
            ' 'Xac dinh dong chua ma HH trong danh muc, gan vao cot 1 cua KQ tam
            j = Dic1.Item(sArrID(i, 1))
            TmpArr(j, 1) = j
        ''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
            RArr(k, 2) = ListArr(i, 1)
            RArr(k, 3) = ListArr(i, 2)
            RArr(k, 4) = ListArr(i, 3)
            ''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 Dic1 = Nothing
Application.ScreenUpdating = True
End Sub

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, nếu không phải là mảng thì hoặc xử lý trực tiếp (nhu bài nộp anh Tuân) hoặc chuyển phần tử không phải là mảng về thành mảng (cách này tôi nghĩ tốt hơn mà tôi mới nghiệm ra):

[GPECODE=vb]
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

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

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.

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

Bài của anh ptm0412 có cải tiến theo kinh nghiệm của vodoi2x tốc độ đạt 317 mili giây. Kết quả vậy là rất nhanh. Cách viết code của anh anh ptm0412 khá giống với em.

ptm0412 đã viết:

Tôi áp dụng 2 việc của vodoi2x vào code của tôi:
- Dùng Value2
- Dùng 5 mảng data nguồn 1 cột thay vì 1 mảng 11 cột
- Giữ nguyên thuật toán (sửa 2 biến Date đều thành Long, cho khỏi ngộ ngộ.)

Sau đó so với code của vodoi2x "Dictionary only" bài mới nhất #156, thấy code của tôi luôn nhanh hơn code vodoi2x của lần chạy đầu tiên.
phương pháp test:
- Code vodoi2x: Xóa những gì liên quan đến 2 biến Run1K và Run1D, xem như không dùng đến dữ liệu đang lưu trữ, mỗi lần chạy là mỗi lần nạp, và chạy 10 lần lấy trung bình.
- Code của tôi cũng chạy 10 lần lấy trung bình
- Đóng excel, test lại 10 lần nữa.

Code:

PHP:

Sub LapSo()
    Application.ScreenUpdating = False
    Dim ListArr(), sArrID(), TmpArr(), RArr(), sArrQty(), sArrAmt(), sArrDocType(), sArrDate()
    Dim Dic1 As Object, 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
    Set Dic1 = CreateObject("Scripting.Dictionary")
    ''Lay danh muc vao mang
    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
    ''Xác dinh dong cuoi cua data va nap vao mang
    With Sheet20
    EndR = .Cells(4, 1).End(xlDown).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
            ' 'Xac dinh dong chua ma HH trong danh muc, gan vao cot 1 cua KQ tam
            j = Dic1.Item(sArrID(i, 1))
            TmpArr(j, 1) = j
        ''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
            RArr(k, 2) = ListArr(i, 1)
            RArr(k, 3) = ListArr(i, 2)
            RArr(k, 4) = ListArr(i, 3)
            ''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 Dic1 = Nothing
Application.ScreenUpdating = True
End Sub

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

dhn46 đã viết:

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)

Mã:

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 · 16/2/14

Hoàng Trọng Nghĩa đã viết:
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 · 16/2/14

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

Mã:

    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:

Mã:

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 · 16/2/14

Nguyễn Duy Tuân đã viết:
Ý 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ả.

Nghĩa đã viết:
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 · 16/2/14

ptm0412 đã viết:
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 · 16/2/14

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 · 16/2/14

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 · 16/2/14

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 · 16/2/14

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!

Mã:

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 · 16/2/14

Hoàng Trọng Nghĩa đã viết:

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!

Mã:

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 · 16/2/14

Nguyễn Duy Tuân đã viết:
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!

Mã:

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 · 16/2/14

Nghĩa đã viết:
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 · 16/2/14

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 · 16/2/14

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 · 16/2/14

ptm0412 đã viết:
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 · 16/2/14

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 · 16/2/14

ptm0412 đã viết:
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. --=0

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 · 16/2/14

Khi đọc đề bài tôi đã có vài chỗ không hiểu nhưng do mọi người đang thi tôi không muốn hỏi vào vì không muốn mọi người mất tập trung.

Tôi không biết người ta ghi sổ sách như thế nào nhưng có vài điểm tôi không hiểu được.

Trích bà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 là Tuân đã cho khái niệm: Mọi Nhập (N) trước ngày 1 cộng với nhau, mọi Xuất (X) cũng cộng với nhau, và hiệu N - X sẽ là tồn đầu.
Theo tôi có vẻ phi thực tế. Vì nếu thế, theo vd. ta thấy ngày 31-07-2005 trong kho không có mặt hàng HH001. Tươnbg tự với các mặt hàng khác. Tức ở thời điểm ngày 31-07-2005 thì kho trống rỗng. Thực tế thì làm gì có kho nào như thế.
Theo cái lôgíc của tôi thì: Nếu tôi làm báo cáo cho khoảng NGAY1 - NGAY2 thì cũng có nghĩa là tôi phải biết được ở thời điểm (NGAY1 - 1) thì trong kho mỗi mặt hàng có bao nhiêu. Giả sử có k mặt hàng trong kho với số lượng là n1, n2, ..., nk thì theo tôi ta sẽ phải tạo vùng dữ liệu kho mà k dòng đầu có ở cột F (tồn đầu) các giá trị n1, n2, ..., nk, tiếp theo là những dòng nhập - tồn trong khoảng NGAY1 - NGAY2.
Nói cách khác ta coi lượng hàng hóa trong kho ở ngày (NGAY1 - 1) là lượng đầu kỳ cho khoảng báo cáo (NGAY1 - NGAY2), tức ta coi n1, n2, ..., nk là lượng hàng hóa mà ta "nhập" từ "kho cũ" sang "kho mới". Và mỗi dòng trong k dòng kể trên có trong cột J ký tự N. Làm gì có chuyện vừa xuất vừa nhập? Ngày 31-07-2005 có bao nhiêu thì ta Nhập (N) vào "kho mới" (trong tưởng tượng thôi) cho báo cáo mới. Thế thôi.

2. Tôi đọc thấy những câu như "mã phát sinh", hay đọc thấy là phải kiểm tra với từng dòng xem nó có thỏa NGAY1 <= ngày <= NGAY2 hay không. Tôi đọc mà không hiểu. Vì theo tôi đã là sổ sách thì có lẽ những mục ghi trong đó là theo thứ tự thời gian. Không có chuyện dòng 100 ứng với ngày 31-07-2005. Cũng không có chuyện ở dòng 100 có ngày 03-09-2005, dòng 102 có ngày 09-09-2005, còn dòng 101 có ngày 01-01-2007 được. Nói cách khác thì nếu tôi hiểu thì các dòng Nhập - Xuất được ghi theo thứ tư thời gian (Làm gì có chuyện thủ kho ngày 08-09-2005 đi làm và ở chỗ làm ghi vào sổ: Ngày 01-01-2007 nhập Honda 5 xe ...). Và nếu thế thì chỉ cần đi từ dòng đầu cho tới ngày >= NGAY1 thì tính những dòng < NGAY1 ta có tồn đầu. Đồng thời có "dòng đầu" của kỳ báo cáo. Đi từ dòng cuối cùng đi lên loại tất cả các dòng trống (nếu có) và các dòng có ngày > NGAY2 ta sẽ có được "dòng cuối". Lúc này thì ta có 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 sẽ không để ý tới cột B nữa mà Nhập - Xuất ta sẽ xác định dựa vào cột J (N - X)

3. Theo tôi sổ sách được ghi theo trình tự thời gian, và theo trình tự các mã xuất hiện và mất đi. Ví dụ ngày xyz có hàng Nhập với mã chưa có thì lập tức mã đó được ghi vào sổ. Không có chuyện có mã trong sheet KHO mà lại không có trong sheet Danh Mục. Nếu sổ sách nghiêm chỉnh thì khi mặt hàng nào đó không còn thì mã tương ứng sẽ bị xóa. Khi đó thì mỗi mã trong sheet KHO sẽ có trong sheet Danh Muc, và ngược lại. Có đk này thì không phải xét từng mả một trong vòng lặp 65000. Vì lúc đó ta "nhắm mắt" mà cho Danh Mục vào Collection, đít thon, mảng.

ptm0412 · 16/2/14

vodoi2x đã viết:
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:

PHP:

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 · 16/2/14

Lê Duy Thương đã viết:
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!

Mã:

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

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

Người dùng đang xem chủ đề này

Nghị Hách

File đính kèm

Thành viên chính thức

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

File đính kèm

Thành viên gạo cội

File đính kèm

Chuyên gia GPE

Nothing & Nothing

Thành viên gạo cội

Nothing & Nothing

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)

Bad Excel Member

Chuyên gia GPE

Bad Excel Member

Chuyên gia GPE

Bad Excel Member

Chuyên gia GPE

Thành viên gạo cội

Nghị Hách

Chuyên gia GPE

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

Huyền thoại GPE

Bad Excel Member

Thành viên gạo cội

Bad Excel Member

Chuyên gia GPE

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

Bad Excel Member

Nothing & Nothing

/(hông là gì!

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

Nghị Hách

Thành viên gắn bó

Đang đi tìm hòn đá

Nothing & Nothing

Chuyên gia GPE

Nothing & Nothing

Hướng tới tương lai

Nothing & Nothing

Chuyên gia GPE

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

Nothing & Nothing

Bad Excel Member

Bad Excel Member

❆❆❆❆❆❆❆❆

Nothing & Nothing

❆❆❆❆❆❆❆❆

Nothing & Nothing

❆❆❆❆❆❆❆❆

Nothing & Nothing

File đính kèm