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

14 Responses

1. hands says:

   30/01/2023 at 1:09 pm

   Hổng hiểu, nhưng bấm thử 10 lần, O5=ROUND(AVERAGE(O6:O35);3)=1212.16
   Bấm nút Test THời gian 10 lần Q5=843.655

   Và code của bác thì chạy con số bao nhiêu??? BẤM "Test thời gian" mới đúng bác nhé –> Kết quả ở ô Q5 (còn O5 là đê chạy code lapso sau khi lắp code vào – dĩ nhiên người lập trình phải ghép vào các sheet data)

   ví dụ code của bác chạy 350 và test thời gian (Q5) là 1212.16
   code của 1 anh A khác chạy 330 và test thời gian 1000

   –> quy đổi nếu code của bác bate chạy trên máy tính của anh A là =350*1000/1212.16 = 288.74 mls – con số này nhỏ hơn 330mls (sub lapso của anh A) ==> code của bác bate thắng , chúc mừng chúc mừng

   Ví dụ thế

   Có lẽ vẫn chưa hiểu lắm sao anh hỏi vậy? Ai lấy cái gì của ai đi thi?
   Bài thi này có phải đố về độ khó để tìm ra kết quả đâu. Các thành viên dùng mọi cách có thể để làm sao tốc độ thực thi code chạy nhanh nhất.

   ý là , lấy dạng bài này đó

   Nếu đó là ý muốn của chủ topic thì không có gì để bàn cả, chỉ thấy đó là vấn đề đã giải nhiều trên GPE, và so sánh tốc độ ở bài dạng này, dường như không khác biệt nhau nhiều lắm, vài phần % giây nên Không rõ đánh giá thế nào, như thế khó tạo ra được cách biệt, ý tôi chỉ thế thôi,

   Và muốn nói thế, để chỉ ra các thành viên khác đừng lo việc khi ai đó nói là đã chạy 400mls hay ít hơn , tiếp tục thử theo cách của riêng đi- vì nó phụ thuộc vào máy tính và trạng thái máy tính chạy ghi đó (RAM, CPU , các chương trình đang chạy vv) – – con nếu máy tính khác nhau thì đã khác nhau tốc độ là cái chắc – nên có khi chạy 400mls ở máy này thì sang máy khác lại là 600mls .

   Có lẽ bạn chủ topic nên công bố thời gian chạy thử nghiệm các bài nộp đã gửi đến — như thế thì mới dễ so sánh hơn (vì thử trên cùng 1 môi trường gần như nhau). và người có bài nộp cũng biết cần hoàn thêm để cải thiện tốc độ nữa hay không (?)

   Đôi lời bàn vậy thôi.

   Để so sánh thời gian với nhau nên đảm bảo các yếu tố như sau:

   1. 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 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).
   b3. Nhấn chạy thủ tục và ghi nhận thời gian thực hiện. Nên thực hiện tối thiểu 3 lần chạy để lấy 3 kết quả khác nhau rồi tính trung bình. Mỗi lần trước bấm nút "Thực hiện" hãy đảm bảo trong Process, CPU và Memory của dòng EXCEL.EXE đang ổn định.

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

   Topic này tôi thấy ngay khi mới tạo, nhưng chưa kịp xem, thậm chí còn không thấy chữ , nên cứ tưởng Tuân giới thiệu 1 thành quả nào đó của mình.

   Mãi đến khi đọc fb mới thấy Nghĩa khích bác tận tên tôi, vào đây lại thấy khích nữa:

   Em nghĩ rất nhiều cao thủ chưa ra tay, tại thấy mỗi lần tham gia "phê bình" ai đó rất tích cực, hoặc lý thuyết rất "dữ dội", chắc những người đó sẽ làm nhanh lắm! Em tin rằng sẽ có người cho kết quả chừng một nửa thời gian của em.

   Tính tôi vẫn thế, sai thì tôi phê, không chính xác thì tôi nói, copy paste mà nhận là tự dịch thì tôi vạch ra. Ăn nói hồ đồ thì tôi mắng. Vậy đấy.

   Còn bài trong topic này tôi viết theo kiểu truyền thống, máy Core 2 Dual 2.9, kết quả tốc độ 537.77551409. Viết xong thì khuya rồi nên chưa sửa, chưa comment.

   Hiện nay em mới có trong tay 2 bài gửi chính thức. Nên để sau 12hAM ngày 15 sẽ upload lên để mọi người test với điều kiện test thống nhất. Từ giờ đến lúc đó mọi người vẫn đi tìm giải pháp cho chính mình để gửi bản cuối cùng.

   Việc máy tính khác nhau, hệ điều hành khác nhau, Excel khác nhau, các ứng dụng đang chạy thường trú khác nhau, quy trình test khác nhau chính là các yếu tố làm cho kết quả đo tốc độ giữa các máy là không giống nhau với cùng một code. Vậy các thành viên cứ tự mình tìm các giải pháp rồi tự so sánh trên máy mình rồi cho ra sản phẩm cuối cùng.

   Các cách làm giống nhau (cùng phái võ), chỉ khác nhau chút ít thì tốc độ đương nhiên chênh lệch ít (nếu không có thêm bí quyết). Các thành viên đã có một số cách khác hẳn nhau, tìm được bí quyết chắc chắn sẽ là khác nhau.

   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:

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

   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.

   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.

   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.

   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.

   ————————————————
   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ó thay đổi bên sheet setting. Tuân xem kỹ tiêu đề báo cáo sẽ thấy kỳ báo cáo khác nhau. Vả lại, trong hình 3, chỉ thể hiện 4 dòng. Các mặt hàng khác không phát sinh trong năm 2015.

   Theo thuật toán của tôi, trong vòng lặp chính (lặp 65 ngàn lần), nếu ngày < ngay1 thì tính 2 cột tồn đầu, nếu ngày < ngay2 thì tính 4 cột nhập xuất. Do đó số lượng dòng có ngày < ngay1 càng nhiều thì tính càng nhanh do chỉ tính 2 cột.

   Hai cột tồn cuối tính trong vòng lặp nhỏ, chỉ lặp 12 lần, không đáng kể.

   Chỉnh sửa 1 chút, giảm số lần tính toán, và thay phép nhân bằng phép cộng, có giảm 1 chút: 418.898

   Cách thực hiện trong code:
   1 Dictionary
   1 Array nguồn
   1 Array tạm
   1 Array kết quả
   1 vòng lặp 65 ngàn vòng

   Array tạm cũng đã là kết quả của việc tính tổng, nhưng chạy thêm 1 vòng lặp 12 vòng để kiểm tra mặt hàng không có phát sinh thì loại ra.

   Sao máy của bạn nhanh thế? Máy của tôi là quãng 4200
   ————
   Theo tôi để đo tốc độ chỉ cần GetTickCount là đủ. Vì sao?
   Một code dài thì bản thân code đó, chạy trên cùng một máy, ở thời điểm gần như nhau với trạng thái máy như nhau (các phần mềm đang chạy) đã cho các kết quả khác nhau rồi. Nếu code chạy mất vd. 800 ms và ta giả thiết là kết quả giữa các lần thử khác nhau là 25 phần nghìn thì có nghĩa là kết quả thực là 800 +- 20 ms.
   Như thế sai số có thể là 20 ms. Vậy thì chả lý gì lại phải dùng QueryPerformanceFrequency + QueryPerformanceCounter. Với sai số cỡ đó thì dùng GetTickCount là đủ.

   QueryPerformanceFrequency + QueryPerformanceCounter ta chỉ dùng khi mà phải đo tốc độ với độ chính xác cực lớn. Tức vd. đo tốc độ của code mà thời gian chạy nó là rất rất nhỏ. Nói cách khác dùng để đo khoảng thời gian cực ngắn.
   ————
   Ngay cả khi so sánh 2 code mà thời gian cho code 1 là 500 còn cho code 2 là 510 thì code nào nhanh hơn? Chạy cùng trên một máy, cùng "môi trường" nhưng chưa chắc đó là 2 môi trường như nhau. Vậy khi mà 2 kết quả khác nhau một lượng nằm trong giới hạn sai số do "dao động" trong system thì khó mà có thể phán code nào chạy nhanh hơn. Tất nhiên khi lượng khác nhau đó là lớn (tỉ lệ "lượng khác nhau" / thời gian gần đúng) thì có thể "yên tâm" đánh giá.
   —
   Vả lại nếu cần so sánh 2 gói đường mà chúng khác nhau ít nhất là cỡ 1 gam thì chả cần dùng cân có độ chính xác là 1 phần trăm (phần nghìn) gam
   Đã ăn gian thì tới bến luôn chứ sao lại nửa vời thế

   Sub DoThoiGian()
   Dim arr
       Dim T1@, T2@, Freq@, Overhead@
   
   arr = he
       Sheets("THNXT").[B12].Resize(UBound(arr), 12).Value = arr
   
   QueryPerformanceFrequency Freq
       QueryPerformanceCounter T1
       QueryPerformanceCounter T2
       Overhead = T2 - T1
       QueryPerformanceCounter T1
       QueryPerformanceCounter T2
   
   MsgBox "milliseconds(ms): " & (T2 - T1 - Overhead) / Freq * 1000
   End Sub

   Trong đó he là hàm làm "mọi việc" và trả về mảng kết quả.
   —
   96 đã là gì. Tôi chạy code trên vài lần, trong đó có lần cho kết quả 0.

   Để so sánh thời gian code của người này với người khác nên đảm bảo các yếu tố như sau:

   1. Tất cả phải chạy trên cùng một máy tính
   Phần cứng máy tính khác nhau, hệ điều hành khác nhau (Phiên bản Windows, 32, 64-bit), phiên bản Excel khác nhau, các ứng dụng đang chạy thường trú khác nhau, quy trình test khác nhau chính là các yếu tố làm cho kết quả đo tốc độ giữa các máy là không giống nhau với cùng một code.

   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).
   b3. Nhấn chạy thủ tục và ghi nhận thời gian thực hiện. Nên thực hiện tối thiểu 3 lần chạy để lấy 3 kết quả khác nhau rồi tính trung bình. Mỗi lần trước bấm nút "Thực hiện" hãy đảm bảo trong Process, CPU và Memory của dòng EXCEL.EXE đang ổn định.

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

   Cái bảng dữ liệu ở sheet kho như thế hình như vẫn sao sao ấy, không biết các kho vật tư như thế nào, riêng kho cảng thì nhập lô hàng nào, khi xuất thì thanh lý, cho nên làm tới đâu tính tới đó.

   Trường hợp nhập CSDL thế này thì 2-3 năm kiểm tra lại, lấy số tồn của thời gian trước ngày TỪ NGÀY thì phải quét hết những năm trước luôn, khi dữ liệu xuất ra thì chắc chắn sẽ có mã hàng có TỒN CUỐI là 0. Với CSDL như vậy sẽ không được hay lắm thì phải.

   Nếu lọc kiểu này thì phải thêm 1 vòng lặp nữa xét nếu mã nào có tồn cuối là 0 thì loại ra.

   Đôi lời góp ý.

   CSDL đơn giản để phục vụ cho làm bài tập này thôi. Còn để làm nghiệp chọn vẹn thì trong CSDL này phải thêm nhiều cột nữa. Anh Nghĩa cứ tạm thế nhé.

   Không phải tồn cuối bằng 0 thì loại ra, mà là đầu kỳ bằng 0, cả nhập cả xuất đều bằng 0 thì mới loại ra.
   Nếu đầu kỳ = 0, nhập 100, xuất 100, tồn cuối = 0 mà loại ra thì sai.

   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.

   Sửa lại dùm em cái này anh Anh Tuân, copy mà không sửa lại:

   If m Then
           Dim ArrProcessing()
           ReDim ArrProcessing(1 To m, 1 To 12)
           For c = 1 To 12
               For r = 1 To m
                   ArrProcessing(r, c) = ArrReport(GetRows(r), c)
               Next
           Next
           Call RowCorrect(m)
           Range("BasicName").Resize(m, 12) = [B][COLOR=#ff0000]ArrProcessing[/COLOR][/B]
       Else
           Call RowCorrect(n)
           Range("BasicName").Resize(n, 12) = ArrReport
       End If

   Sửa lại chỗ màu đỏ anh nhé! Thanks.

   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:

   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..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.
   Date2 = Sheet3.

   ' 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..Resize(12, 12).ClearContents
   Sheet26..Resize(k, 12) = RArr
   Set Dic1 = Nothing
   Application.ScreenUpdating = True
   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.

   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!

   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?

   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!

   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.

   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.

   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

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

   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)

   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.

   Chuyện góp ý là chuyện bình thường. Nhưng tôi thấy bạn "đeo bám" những cái tủn mủn quá.
   Thế nếu không khai là Long mà khai là Variant thì có thấy kỳ không? Vì thực ra ngày tháng là kiểu Variant.
   Nói trắng ra là ngày tháng được lưu ở dạng số (numeric) nên chuyện khai báo biến là Long chả có gì là ngồ ngộ cả. Thậm chí khai báo là Double cũng chả có gì là ngồ ngộ. Vì thực chất ngày giờ được lưu ở dạng đó. Chỉ có điều là ở đây ta chỉ làm việc với ngày tháng, không có thời gian, tức làm việc với số nguyên nên không cần tới Double mà chỉ cần Long. Nhu cầu chỉ cần tới numeric kiểu Long (4 bai) thì dùng Long là hợp lý. Đâu có cần, trong trường hợp chỉ có ngày mà không có giờ, tới kiểu Date – Variant – Double (8 bai)?

   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.

   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.

   Đồ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 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

   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

   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

   Đọ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 đó

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

   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ú ý:

   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

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

   

   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
   có cập nhập lại code cho [URL='https://www.giaiphapexcel.com/forum/showthread.php?89723-THI-T%E1%BA%A1o-s%E1%BB%95-TH-NXT-v%E1%BB%9Bi-t%E1%BB%91c-%C4%91%E1%BB%99-nhanh-nh%E1%BA%A5t-d%E1%BB%AF-li%E1%BB%87u-65-532-d%C3%B2ng&p=560702#post560702'%5Dbài 141 và [URL='https://www.giaiphapexcel.com/forum/showthread.php?89723-THI-T%E1%BA%A1o-s%E1%BB%95-TH-NXT-v%E1%BB%9Bi-t%E1%BB%91c-%C4%91%E1%BB%99-nhanh-nh%E1%BA%A5t-d%E1%BB%AF-li%E1%BB%87u-65-532-d%C3%B2ng&p=560718#post560718'%5Dbà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 ,

   —

   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.

   Có nhiều trường hợp bạn không dùng tới 2 mảng keys, items mà.

   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 là class mà bạn. Bạn dùng class chán chê rồi mà.

   Chỉ cần Set collection = Nothing thôi.

   Dim Coll As New Collection
   ....
   Coll.Add ...
   
   hoặc
   
   Dim Coll As Collection
   ...
   Set Coll = New Collection
   Coll.Add ...
   ...
   Set Coll = Nothing

   Nếu bạn Add key đã có thì sẽ có lỗi. Vì bạn có thể truy cập tới Item hoặc bằng chỉ 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 có 2 key như nhau thì làm sao biết phải trả về Item nào?

   Kiểu truy cập bằng index hoặc bằng "tên" – key thì bạn dùng chán rồi. Vd. Sheets(1), sheets("Sheet1") …

   Khi bạn Add key đã tồn tại thì sẽ có lỗi

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

   Vậy thì cũng có thể kiểm tra cái trên để biết có key đó chưa (Exists)

   Nhưng với collection khi dùng Add thì key là không bắt buộc.

   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.

   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:

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

   Tôi không phủ nhận là có nhiều khi cần keys, items. Tôi chỉ nói là có 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 ạ?

   Thì có nghĩa là trong phương thức Add thì chỉ tham số đầu Item là bắt buộc còn 3 tham số khác là Optional.
   Nếu nhập Key thì sau đó có thể truy cập tới Item bằng key (ngoài cách bằng index). Nếu không nhập Key thì mất khả năng này, tức chỉ truy cập tới Item bằng index thôi.

   Tất nhiên nếu ta muốn dùng collection để lọc duy nhất thì ta sẽ nhập key. Tôi chỉ nhấn mạnh là key không bắt buộc. Nghĩa là "có thể, được phép nhưng không bắt buộc".

   Reply
2. hands says:

   30/01/2023 at 1:12 pm

   Đã khắc phục tại [URL="https://www.giaiphapexcel.com/forum/showthread.php?89723-THI-T%E1%BA%A1o-s%E1%BB%95-TH-NXT-v%E1%BB%9Bi-t%E1%BB%91c-%C4%91%E1%BB%99-nhanh-nh%E1%BA%A5t-d%E1%BB%AF-li%E1%BB%87u-65-532-d%C3%B2ng&p=560743#post560743"%5Dbài 144

   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

   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

   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

   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.

   Đú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

   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:

   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)

   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

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

   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 [URL="https://www.giaiphapexcel.com/forum/showthread.php?89723-THI-T%E1%BA%A1o-s%E1%BB%95-TH-NXT-v%E1%BB%9Bi-t%E1%BB%91c-%C4%91%E1%BB%99-nhanh-nh%E1%BA%A5t-d%E1%BB%AF-li%E1%BB%87u-65-532-d%C3%B2ng&p=560851#post560851"%5D#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.

   2561

   Code:
   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..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.
   Date2 = Sheet3.
   ''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..Resize(12, 12).ClearContents
   Sheet26..Resize(k, 12) = RArr
   Set Dic1 = Nothing
   Application.ScreenUpdating = True
   End Sub

   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.

   Đúng là bài toán này dùng ADO là gọn và uyển chuyển nhất, tuy nhiên tốc độ so với những cách khác ở trên thì rất hạn chế. Cách ADO so với cách của anh vodoi2x thì ADO sẽ cho thời gian chậm hơn gấp 20 lần. Topic này đưa ra nhằm tìm cách giải quyết với thời gian nhanh nhất. Xét thấy ADO không có được ưu điểm về tốc độ cho bài toán này nên em đành theo dõi và học hỏi thêm từ những cách khác.

   Offset resize, không làm giảm tốc độ đáng kể đâu ah,
   đú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,

   Nếu dùng ADO thì xử lý cái này rất đơn giản.

   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 ở [URL="https://www.giaiphapexcel.com/forum/showthread.php?89723-THI-T%E1%BA%A1o-s%E1%BB%95-TH-NXT-v%E1%BB%9Bi-t%E1%BB%91c-%C4%91%E1%BB%99-nhanh-nh%E1%BA%A5t-d%E1%BB%AF-li%E1%BB%87u-65-532-d%C3%B2ng&p=560851#post560851"%5Dbà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 [URL="https://www.giaiphapexcel.com/forum/showthread.php?89723-THI-T%E1%BA%A1o-s%E1%BB%95-TH-NXT-v%E1%BB%9Bi-t%E1%BB%91c-%C4%91%E1%BB%99-nhanh-nh%E1%BA%A5t-d%E1%BB%AF-li%E1%BB%87u-65-532-d%C3%B2ng&p=560956#post560956"%5Dbài 162

   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..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.
   Date2 = Sheet3.
   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..Resize(12, 12).ClearContents
   Sheet26..Resize(k, 12) = RArr

   ''With Sheet26..Offset(k)
   '' Union(.Offset(, 5), .Offset(, 7), .Offset(, 9), .Offset(, 11)).Formula = "=SUM(RC:RC)"
   ''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)

   Reply
3. hands says:

   30/01/2023 at 1:13 pm

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

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

   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

   – 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!

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

   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!

   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:

   [URL='https://www.giaiphapexcel.com/forum/showthread.php?35487-Filter-and-get-the-unique-values-L%E1%BB%8Dc-v%C3%A0-l%E1%BA%A5y-c%C3%A1c-gi%C3%A1-tr%E1%BB%8B-kh%C3%B4ng-tr%C3%B9ng&p=235231#post235231']https://www.giaiphapexcel.com/forum/showthread.php?35487-Filter-and-get-the-unique-values-Lọc-và-lấ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
   [URL='https://www.giaiphapexcel.com/forum/showthread.php?84136-Ph%C6%B0%C6%A1ng-ph%C3%A1p-l%E1%BB%8Dc-duy-nh%E1%BA%A5t-t%E1%BB%AB-danh-s%C3%A1ch&p=524518#post524518']https://www.giaiphapexcel.com/forum/showthread.php?84136-Phương-pháp-lọc-duy-nhất-từ-danh-sách&p=524518#post524518

   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:

   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:

   [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):

   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ứ!

   Reply
4. hands says:

   30/01/2023 at 1:17 pm

   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:

   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

   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.

   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

   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é!

   Reply
5. hands says:

   30/01/2023 at 1:18 pm

   Cảm ơn anh [URL="https://www.giaiphapexcel.com/forum/member.php?24-Nguy%E1%BB%85n-Duy-Tu%C3%A2n"%5DNguyễ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 [URL="https://www.giaiphapexcel.com/forum/member.php?24-Nguy%E1%BB%85n-Duy-Tu%C3%A2n"%5DNguyễn Duy Tuân Test hộ em Code sau khi dùng biến tạm để có thể so sánh với việc không dùng biến tạm tại bài #175.
   Qua bài #139 của anh Vodoi2x em cũng đã test và thấy nếu dùng .Value2 gán cho mảng thì tốc độ cũng được cải thiện, đây là một cái mới với em mà quan topic này em đã may mắn được biết.

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

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

   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.

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

   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 [URL='https://www.giaiphapexcel.com/forum/showthread.php?89723-THI-T%E1%BA%A1o-s%E1%BB%95-TH-NXT-v%E1%BB%9Bi-t%E1%BB%91c-%C4%91%E1%BB%99-nhanh-nh%E1%BA%A5t-d%E1%BB%AF-li%E1%BB%87u-65-532-d%C3%B2ng&p=560956#post560956'%5D#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.

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

   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

   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.

   Reply
6. hands says:

   30/01/2023 at 1:20 pm

   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 [URL='https://www.giaiphapexcel.com/forum/showthread.php?89723-THI-T%E1%BA%A1o-s%E1%BB%95-TH-NXT-v%E1%BB%9Bi-t%E1%BB%91c-%C4%91%E1%BB%99-nhanh-nh%E1%BA%A5t-d%E1%BB%AF-li%E1%BB%87u-65-532-d%C3%B2ng&p=560851#post560851'%5D#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.

   [URL='https://s1329.photobucket.com/user/ptm041261/media/Excel01/compare_zpsd523ee8f.jpg.html'%5D

   

   Code:
   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..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.
   Date2 = Sheet3.
   ''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..Resize(12, 12).ClearContents
   Sheet26..Resize(k, 12) = RArr
   Set Dic1 = Nothing
   Application.ScreenUpdating = True
   End Sub

   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.

   Cảm ơn anh [URL='https://www.giaiphapexcel.com/forum/member.php?24-Nguy%E1%BB%85n-Duy-Tu%C3%A2n'%5DNguyễ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 [URL='https://www.giaiphapexcel.com/forum/member.php?24-Nguy%E1%BB%85n-Duy-Tu%C3%A2n'%5DNguyễn Duy Tuân Test hộ em Code sau khi dùng biến tạm để có thể so sánh với việc không dùng biến tạm tại bài #175.
   Qua bài #139 của anh Vodoi2x em cũng đã test và thấy nếu dùng .Value2 gán cho mảng thì tốc độ cũng được cải thiện, đây là một cái mới với em mà quan topic này em đã may mắn được biết.

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

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

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

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

   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

   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

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

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

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

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

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

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

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

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

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

   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.

   Reply
7. hands says:

   30/01/2023 at 1:23 pm

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

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

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

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

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

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

   Option Explicit
   Declare Function QueryPerformanceCounter Lib "Kernel32" _
                           (x As Currency) As Boolean
   Declare Function QueryPerformanceFrequency Lib "Kernel32" _
                           (x As Currency) As Boolean
   
   ''Cac ham kiem tra:
   Function Exists(ByRef Collect As Collection, ByVal sKey As String) As Boolean
       Dim lCheck As Long
       On Error Resume Next
       lCheck = VarType(Collect.Item(sKey))
       If Err.Number = 0 Then
           Exists = True
       Else
           Exists = False
       End If
   End Function
   
   Function ItemExists(Item, Arr()) As Long
       Dim i&
       ItemExists = -1
       On Error GoTo lbDone
       If Not IsArray(Arr) Then Exit Function
       'Tim tu phan tu cuoi cung cua mang len dau se dat toc do tim nhanh neu du lieu nguon duoc sap xep tang dan
       For i = UBound(Arr) To LBound(Arr) Step -1
           If Arr(i) = Item Then
               ItemExists = i
               Exit For
           End If
       Next i
   lbDone:
   'Loi xay ra neu
   End Function
   
   Sub DoThoiGian()
       Dim T1@, T2@, Freq@, Overhead@
       QueryPerformanceFrequency Freq
       QueryPerformanceCounter T1
       QueryPerformanceCounter T2
       Overhead = T2 - T1
       QueryPerformanceCounter T1
   
   ''Tot nhat cho du lieu tu duoi 200 ngan dong:
       DictTest
   
   ''Tu tren 200 ngan dong tro len:
       'CollTest
   
   'Chi 10 ngan dong da thay qua cham:
       'ArrTest
   
   QueryPerformanceCounter T2
       Debug.Print (T2 - T1 - Overhead) / Freq * 1000; "milliseconds(ms)"
   End Sub
   
   ''Test cac thu tuc:
   ''----------------------------------------------------
   Sub DictTest()
       Dim i As Long
       Dim Dict As Object
       Set Dict = CreateObject("Scripting.Dictionary")
       For i = 1 To [COLOR=#0000ff]200000[/COLOR]
           If Not Dict.Exists("Nghia" & i) Then
               Dict.Add "Nghia" & i, i
           End If
       Next
   End Sub
   
   Sub CollTest()
       Dim i As Long
       Dim Collect As New Collection
       For i = 1 To [COLOR=#0000ff]200000[/COLOR]
           If Not Exists(Collect, "Nghia" & i) Then
               Collect.Add i, "Nghia" & i
           End If
       Next
   End Sub
   
   Sub ArrTest()
       Dim i As Long
       Dim Arr(1 To [COLOR=#ff0000]10000[/COLOR])
       For i = 1 To [COLOR=#ff0000]10000[/COLOR]
           If ItemExists("Nghia" & i, Arr) = 0 Then
               Arr(i) = "Nghia" & i
           End If
       Next
   End Sub

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

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

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

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

   Option Explicit
   Declare Function QueryPerformanceCounter Lib "Kernel32" _
                           (x As Currency) As Boolean
   Declare Function QueryPerformanceFrequency Lib "Kernel32" _
                           (x As Currency) As Boolean
   
   Private Dict As Object, Collect As New Collection, Arr(), Check As Boolean
   
   ''Test cac thu tuc:
   ''----------------------------------------------------
   Sub GetData()
       ''chay mot lan duy nhat!
       Set Dict = Nothing
       Set Collect = Nothing
       Erase Arr
   
   Dim i As Long
       Set Dict = CreateObject("Scripting.Dictionary")
       ReDim Arr(1 To 200000)
       For i = 1 To 200000
           Dict.Add "Nghia" & i, i
           Collect.Add i, "Nghia" & i
           Arr(i) = "Nghia" & i
       Next
   End Sub
   
   Sub DictTest()
       Check = Dict.Exists("Nghia" & 2000001)
   End Sub
   
   Sub CollTest()
       Check = Exists(Collect, "Nghia" & 2000001)
   End Sub
   
   Sub ArrTest()
       Check = Not (ItemExists("Nghia" & 2000001, Arr) = 0)
   End Sub
   
   ''Cac ham kiem tra:
   Function Exists(ByRef Collect As Collection, ByVal sKey As String) As Boolean
       Dim lCheck As Long
       On Error Resume Next
       lCheck = VarType(Collect.Item(sKey))
       If Err.Number = 0 Then
           Exists = True
       Else
           Exists = False
       End If
   End Function
   
   Function ItemExists(Item, Arr()) As Long
       Dim i&
       ItemExists = -1
       On Error GoTo lbDone
       If Not IsArray(Arr) Then Exit Function
       'Tim tu phan tu cuoi cung cua mang len dau se dat toc do tim nhanh neu du lieu nguon duoc sap xep tang dan
       For i = UBound(Arr) To LBound(Arr) Step -1
           If Arr(i) = Item Then
               ItemExists = i
               Exit For
           End If
       Next i
   lbDone:
   'Loi xay ra neu
   End Function
   
   Sub DoThoiGian()
       Dim T1@, T2@, Freq@, Overhead@
       QueryPerformanceFrequency Freq
       QueryPerformanceCounter T1
       QueryPerformanceCounter T2
       Overhead = T2 - T1
       QueryPerformanceCounter T1
   
   ''Tot nhat cho du lieu tu duoi 200 ngan dong:
       'DictTest
   
   ''Tu tren 200 ngan dong tro len:
       'CollTest
   
   'thay doi:
       ArrTest
   
   QueryPerformanceCounter T2
       Debug.Print (T2 - T1 - Overhead) / [COLOR=#ff0000][B]Freq * 1000000[/B][/COLOR]; "milliseconds(ms) " & Check
   End Sub

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

   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?

   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.

   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ả!

   Reply
8. hands says:

   30/01/2023 at 1:24 pm

   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.

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

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

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

   Reply
9. hands says:

   30/01/2023 at 1:24 pm

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

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

   Trích bài #22

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

   Tương tự khi tính giá trị…

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

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

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

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

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

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

   Lượng Nhập trong kỳ = lượng nhập với ngày >= NGAY1 và ngày <= NGAY2
   Lượng Xuất trong kỳ = lượng xuất với ngày >= NGAY1 và ngày <= NGAY2

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

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

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

   Anh siwtom nói rất đúng. Tôi tham gia vì muốn góp 1 thuật toán mà tôi thường dùng, nhưng trong các bài viết tôi cũng nhắc đi nhắc lại 3 điều:
   – data không có thứ tự ngày tháng nên phải duyệt đủ 65000 dòng
   – Dự phòng có số dư đầu kỳ chứ không phải trước ngày 01/07/2005 kho rỗng không
   – Dữ liệu phải kiểm tra mã ngay khi nhập vào, chứ không phải saucùng mới kiểm tra và thêm thêm. Mà thêm xong cũng chỉ có mã, không có tên và đơn vị tính.

   Code của tôi viết cũng như anh nói: "nhắm mắt mà cho danh mục vào đít thon" và "nhắm mắt mà duyệt mảng không cần kiểm tra"

   Reply
10. hands says:

    30/01/2023 at 1:25 pm

    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:

    [URL="https://s1329.photobucket.com/user/ptm041261/media/Excel01/compare-collecttion_zps64bd6572.jpg.html"%5D

    

    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..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.
    Date2 = Sheet3.
    ''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..Resize(12, 12).ClearContents
    Sheet26..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

    Reply
11. hands says:

    30/01/2023 at 1:32 pm

    Một dữ liệu không được SORT hay sao các bác? Một người thích sort theo kiểu mã hàng/ tên hàng, một người sort theo ngày tháng, một người thích sort theo kiểu xyz nào đó, vậy trật tự có phải lộn xộn cả lên hay không? Muốn vậy thì các bác phải SORT lại theo ý mình và thực theo ý đồ của các bác chứ?

    Đây là một dạng bài tập thôi, chứ CSDL thật có lẽ không phải là như vậy!

    Theo tôi, thì cần phải có một cột tình trạng, nếu đã thanh lý lô hàng thì cột này ghi "thanh lý", sort cột này một cái là ra các hàng chưa thanh lý, thế lả tính toán thoải mái luôn.

    Sau bao nhiêu năm chẳng hạn thì các hàng có thanh lý (theo kiểu FIFO) sẽ được dời đi (vào một CSDL nào đó chẳng hạn để lưu trữ). Cho nên luôn đảm bảo số việc truy xuất dữ liệu.

    Nghĩa nên nhớ rằng Tuân không cho sort. Và nên đọc để biết rằng trong 1 bài nào đó Tuân nói dữ liệu dùng để ra đề đã được giả lập bằng cách copy nên nó thế, chứ không phải ban đầu nó thế. Phải chấp nhận để thi.
    Dữ liệu gốc không ai sort tùm lum cả. Đúng tiêu chuẩn là nhập hàng ngày theo thứ tự ngày tháng. Muốn xem kiểu gì thì mở báo cáo đó lên xem: Filter, group, … sẵn thành báo cáo đẹp đẽ luôn.

    Còn vụ "thanh lý" thì tôi cũng nói rồi. Sau 1 năm người ta xóa bỏ hoặc đánh dấu những mặt hàng không còn sử dụng ra khỏi danh mục. Đó là dữ liệu "rác". Cũng chính vì thế nên người ta không nhập sẵn 10.000 mã chưa dùng đến vào danh mục, vì không xài tức là rác. Khi được chào hàng hoặc thông báo mã hàng mới, người ta sẽ lưu ở chỗ khác theo dạng catalogue để tham khảo, khi nào thực sự dùng mới add, dùng bao nhiêu, add bấy nhiêu.

    Nghĩa còn hiểu sai về FIFO. Dù dùng FIFO hay dùng bất kỳ phương pháp tính giá nào, thì vẫn có những mặt hàng dùng mãi mãi, và cũng có mặt hàng chỉ dùng 1 thời gian rồi không dùng nữa. người ta loại mặt hàng không dùng, chứ không loại mặt hàng cũ nhất.

    Tôi cũng nghĩ là dữ liệu gốc được ghi theo trình tự thời gian và không có sort gì cả. Mọi nhu cầu: sort theo mã hàng, theo khách hàng (?), trích ra bảng con chỉ có một số cột, báo cáo …, tất cả được làm ở sheet mới. Những cái đó có thể chỉ cần thiết nhất thời và sau đó có thể xóa đi. Riêng dữ liệu nguồn thì bất di bất dịch.

    Công thức em đã gợi ý cho mọi người như sau:
    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

    Anh đang thắc mắc phần tồn đầu nên em giải thích thêm.
    – Trong thực tế kiểm kho, số tồn đầu kỳ cụ thể luôn là nhập (LOAI_PHIEU="N"). Nói tồn đầu thì chỉ là tồn đầu và nhập không có xuất – Ý anh nói đúng.
    – Với người làm nghiệp vụ kho. Báo cáo nộp định kỳ, ví dụ nộp cuối năm thì tồn đầu sẽ cố định ngày < 1/1/xx, và chắc chắn chỉ có loại nghiệp vụ là nhập không có xuất.
    – Thực tế trong quá trình quản lý kho của người làm nghiệp vụ, cần theo dõi diễn biến của hàng hoá vật tư kho theo các khoảng thời gian bất kỳ mà họ muốn. NGAY1-NGAY2 là tuỳ ý. Không cứ NGAY1 phải là 1/1/xx. Vì thế nói tới đầu kỳ là nói "Tồn đầu kỳ" chứ không nói "Nhập đầu kỳ". "Nhập đầu kỳ" thì có thể chỉ cần xét phếu nhập, nhưng "Tồn đầu kỳ" (mà ngày đầu có thể bất kỳ) thì phải tính Nhập – Xuất (với ngày < NGAY1).

    Không biết ở các đơn vị mọi người thế nào nhưng ở nhiều đơn vị mà công ty tôi hỗ trợ nghiệp vụ kho cho bộ phận quản lý kho họ đều đồng ý vơí cách làm làm báo cáo theo công thức như vậy.

    Về dữ liệu đề ra. Như tôi đã nói, chỉ làm dữ liệu tính toán chứ nó không phải là thật. Cấu trúc bảng KHO được đơn giản hoá để làm báo cáo mà thôi. Dữ liệu được copy paste nhiều lần để cho nó có nhiều, vì thế thứ tự thời gian không theo và số phiếu trùng,…. Mà với đặc điểm của Excel thì thứ tự thời gian hay các cột khác cũng không theo được trình tự sắp xếp. Ví dụ sửa, xoá chứng từ mà người lập trình không muốn lệnh Insert, một lúc nào đó người ta đem Sort lại…..

    Có lẽ chúng ta có thể trao đổi tiếp về các vấn đề liên quan đến code còn bàn luận về tính thực tế nghiệp vụ mỗi đơn vị ta tạm dừng lại vì khó để đi đến thống nhất cuối cùng và làm loãng topic.

    Khi sửa ngày bắt đầu và ngày kết thúc còn lỗi lung tung.
    Ngoài ra, chưa có lệnh refresh pivot table.
    Sheet PV cần gì xóa, Pivot cũng không cần xóa, hoặc muốn xóa thì xóa pivot table, cần gì xóa cả sheet.

    Download: https://www.mediafire.com/download/86m5ib7c14459cw/THNXT_FAST-LDT-EditByPtm.rar

    Anh Nghĩa làm thủ tục test chưa đầy đủ vì để so sánh tốc độ của của Array, Dictionary, Collection phải tính thời gian khi nạp dữ liệu vào nó (code ở bài cụ thể ta cũng phải nạp mà) và cả khi kiểm tra Exists có tồn tại và không tồn tại. Hàm ItemExists sẽ tìm nhanh trong trường hợp đã nêu ở bài trên.

    Nếu có thời gian anh Nghĩa dùng Dictionary và Collection thay vào file của em ở bài tổng hợp xem khác nhau không?
    Đã 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ả. Các thành viên xem bài [URL='https://www.giaiphapexcel.com/forum/showthread.php?89723-THI-T%E1%BA%A1o-s%E1%BB%95-TH-NXT-v%E1%BB%9Bi-t%E1%BB%91c-%C4%91%E1%BB%99-nhanh-nh%E1%BA%A5t-d%E1%BB%AF-li%E1%BB%87u-65-532-d%C3%B2ng/page18'%5D#175 để download.
    Qua đề topic dạng "THI" kiểu này cá nhân mình nhìn nhận chủ quan thì thấy nó bổ ích cho mọi người. Không biết nhiều người khác có thực sự thấy như vậy và hứng thú không? Nếu được thì sắp tới chúng ta lại có thêm một đề tài mới. Bài toán cũng vẫn sẽ là có vẻ đơn giản nhưng làm ta lại học thêm được một số cái mới.

    Đừng vội kết luận điều gì chỉ qua 1 bài ví dụ

    Tôi nghĩ là: Đừng vội kết luận điều gì chỉ qua 1 bài ví dụ, cụ thể ở đây không thể nói Collection là tốt, hay Dictionary là không bằng, hay Array là giải pháp tốt,

    Quả thực như thế, bài này về giá trị kết quả hay cả trong bảng danh mục (sheet DMVLSPHH) cũng chỉ tối đa có 12 mã hàng hóa khác nhau ==> dùng Dictionary, hay collection, hay array để lưu trữ / kiểm tra sự tồn tại (Exists) vào lúc tối đa số items/phần tử cũng chỉ là 12 —> quá nhỏ để thấy sự khác biệt — vì ví dụ ta dùng array thì cùng lắm 12 vòng lặp là chỉ ra itemExist hay không 12 vòng lặp với 1 phép kiểm tra tồn tại thì đâu tiêu tốn nhiều thời gian,

    Mặt khác hiệu quả của các công cụ có sẵn như Dictionary, Collection thì lại cần 1 thời gian khởi nóng càng ít items thì hiệu quả của chúng về mặt thời gian sẽ giảm,

    Bên cạnh đó, thì ta thấy các giải pháp ở đây chênh nhau rất ít vài chục đến vài trăm mili giây (tức là 1/5 1/4 giây) mà thôi, như thế thì cũng đâu quan trọng đâu, chớp mắt 2 cái là đã qua hơn 1 giây , còn uống tách cafe thì tính bằng đơn vị 15 phút (=900 giây), nên mọi so sánh là tương đối. Đôi khi với bài toán dạng này (thời gian tiêu tốn nhỏ) thì ta hy sinh yếu tố thời gian để code được sáng và ít lỗi hơn , sử dụng công cụ quen thuộc (tránh được các lỗi không lường thấy hoặc chưa rõ).

    ===> chưa kết luận được điều gì ở đây cả, chỉ có thể kết luận là có nhiều cách đi đến kết quả nhanh của chính bài này, và một số thủ thuật giảm thời gian tính mà thôi.

    Nói vậy, để tránh trường hợp kết luận quá sớm, lại thành như mệnh đề sai lầm cho cả diến đàn , cứ mặc định nghĩ là đúng dù chúng có thể chỉ qua 1 2 bài test chưa đầy đủ.
    Vội khép lại topic sớm vậy, tôi nghĩ vẫn còn các giải pháp khác như SQL với ADO , DAO mà, hay giải pháp Class

    Dĩ nhiên có thể thời gian các giải pháp này kém hơn, nhưng quan trọng qua đó người xem (thành viên) thu lượm được các phương pháp tiếp cận khác nhau khi giải quyết 1 vấn đề / bài toán thực tế — có như vậy mới tạo thành bữa tiệc đa sắc

    Vâng. Là nói vậy chứ chưa khép mà anh. Em cung mong các thành viên tiếp tục gửi thêm giải pháp để cùng học hỏi.

    Tôi đã gợi ý rồi. Đo tốc độ tuyệt đối thì còn phải tuỳ thuộc vào tình trạng dữ liệu. VD: dùng ADO, chỉ riêng thời gian đợi nó kết nối cũng tuỳ thuộc vào kiến trúc của hệ thống vận hành rồi. Còn muôn vạn vấn đề khác như DAO nhanh hơn nhưng không bao quát và tiêu chuẩn bằng ADO, vv…

    Nếu chỉ cần học cách uốn nắn cho code chạy nhanh thì như thế này là đủ rồi.
    Những cái còn lại thuộc về thủ thuật phân tích vấn đề và trình bày code cho dễ hiểu, dễ sửa. Đôi khi làm cái này phải chấp nhận code chạy chậm một chút.

    Riêng các công cụ đặc biệt như DAO và ADO,… Nhũng công cụ này dùng SQL để sắp xếp và tổng hợp dữ liệu cho nên chúng còn tuỳ thuộc vào bộ máy Access (hay SQL Server, vv…) có phần tối ưu hoá câu lệnh SQL hay không – hai câu lệnh viết khác nhau có thể bộ máy tự động được tối ưu hoá thành in hệt nhau.

    Giải pháp cập nhập cải tiến sử dụng Dictionary

    Ở đây vẫn sử dụng giải pháp 2 dictionary (đảm bảo mọi mặt hàng phát sinh mới ở kho mà không có trong danh mục – dĩ nhiên điều này chỉ có tốt lên, và phòng trường hợp nhập mã sai vv.vvv)

    So với giải pháp 2 Dictionary cũ (xem file tại [URL="https://www.giaiphapexcel.com/forum/showthread.php?89723-THI-T%E1%BA%A1o-s%E1%BB%95-TH-NXT-v%E1%BB%9Bi-t%E1%BB%91c-%C4%91%E1%BB%99-nhanh-nh%E1%BA%A5t-d%E1%BB%AF-li%E1%BB%87u-65-532-d%C3%B2ng&p=561089#post561089"%5Dbài 175) của chính tôi, thì giải pháp mới ở sub code sau đã giảm được khoảng 100mili giây (từ khoảng 330mls xuống 230mls tại lap của tôi), tiến tới chỉ kém giải pháp collection hiện đang có thời gian nhỏ nhất (xem tại [URL="https://www.giaiphapexcel.com/forum/showthread.php?89723-THI-T%E1%BA%A1o-s%E1%BB%95-TH-NXT-v%E1%BB%9Bi-t%E1%BB%91c-%C4%91%E1%BB%99-nhanh-nh%E1%BA%A5t-d%E1%BB%AF-li%E1%BB%87u-65-532-d%C3%B2ng&p=561089#post561089"%5Dbài 175) là (chậm hơn) khoảng10% (cụ thể tại lap tôi thì giải pháp Collection là khoảng 208mls, còn giải pháp 2 dictionary cải tiên mới này là khoảng 230mls – theo tôi dự thì trên máy tính test của Nguyễn Duy Tuân chắc khoảng 275mls)

    Code của sub lapso với giải pháp cải tiến sử dụng 2 dictionary như sau

    Private Sub LapSo()
    ''Code lap so th nxt
    ''Su Dung Dictionary
    ''nguoi Lap: vodoi2x
    ''email: vodoi909090@yahoo.com
    '' ngay cap nhap: 19.02.2014

    Application.ScreenUpdating = False
    Dim DicH, arrRes(), soDM()
    Dim Day1 As Long, Day2 As Long, i As Long, k As Long, p As Long
    Dim DicDM, Ngay(), MaSoHH(), SoLG(), LoaiPhieu(), ThanhTien()

    ''Nhap du lieu ngay tinh toan
    Day1 = Range("NGAY1").Value2
    Day2 = Range("NGAY2").Value2

    ''Nhap du lieu tu KHO
    With Range("KHO").Resize(Range("KHO").Rows.Count – 1, 1).Offset(1, 1)
    Ngay = .Value2
    MaSoHH = .Offset(, 5).Value2
    SoLG = .Offset(, 6).Value2
    LoaiPhieu = .Offset(, 8).Value2
    ThanhTien = .Offset(, 9).Value2
    End With

    ''nhap DL tu vung DM VLSPHH
    soDM = Range("DMVLSPHH").Resize(Range("DMVLSPHH").Rows.Count – 1, 3).Offset(1).Value2
    p = UBound(soDM)

    ReDim arrRes(1 To p + 10, 1 To 12) ''Mang chua ket qua gom 12 cot, 10 so ma du phong chua co trong DM VLSPHH
    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

    p = DicH.Item(MaSoHH(i, 1))
    If p = 0 Then ''Truong hop CHUA CO MaHH trong Dictionary DicH, nen ta cong vao, va gan gia tri vao arrRes
    k = k + 1
    DicH(MaSoHH(i, 1)) = k
    arrRes(k, 2) = MaSoHH(i, 1)
    p = k
    End If '' If p = 0 Then

    If Ngay(i, 1) < Day1 Then ''ton dau ky
    If LoaiPhieu(i, 1) Like "N" Then
    arrRes(p, 5) = arrRes(p, 5) + SoLG(i, 1)
    arrRes(p, 6) = arrRes(p, 6) + ThanhTien(i, 1)
    Else
    arrRes(p, 5) = arrRes(p, 5) – SoLG(i, 1)
    arrRes(p, 6) = arrRes(p, 6) – ThanhTien(i, 1)
    End If
    Else ''trong ky
    If LoaiPhieu(i, 1) Like "N" Then
    arrRes(p, 7) = arrRes(p, 7) + SoLG(i, 1)
    arrRes(p, 8) = arrRes(p, 8) + ThanhTien(i, 1)
    Else
    arrRes(p, 9) = arrRes(p, 9) + SoLG(i, 1)
    arrRes(p, 10) = arrRes(p, 10) + ThanhTien(i, 1)
    End If
    End If

    End If ''——————————————————– If Ngay(i, 1) <= Day2 Then
    Next i

    ''tao DicDM de luu tru vi tri cua Ten hang hoa & Don vi tinh
    Set DicDM = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(soDM)
    DicDM(soDM(i, 1)) = i
    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
    Dim j As Long
    For i = 1 To k
    arrRes(i, 1) = i
    j = DicDM(arrRes(i, 2))
    If j > 0 Then
    arrRes(i, 3) = soDM(j, 2)
    arrRes(i, 4) = soDM(j, 3)
    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)
    Next i
    arrRes(p, 12) = arrRes(p, 6) + arrRes(p, 8) – arrRes(p, 10)

    ''Xuat ket qua ra Sheet
    With Sheet26.Range("b12")
    .Resize(13, 12).ClearContents
    If k Then .Resize(p, 12) = arrRes
    End With

    End Sub

    Vậy các bạn thử tìm ra đâu là thủ thuật cải tiến trong sub này? tìm ra sẽ thấy giải pháp rút ngắn thời gian tính với dictionary, thật đơn giản, và sẽ phát hiện ra cả hạn chế cuả thủ thuật này (?)

    Đọc hổng hiểu nổi (tôi hơi lười đọc chứ không phê bình cách viết) cho nên chả biêt cải tiến ở đâu.

    Duy có một chút kiến thức cùi:
    Dictionary là một class nằm trong Scripting Engine.
    Theo nguyên tắc Lập Trình Hướng Đối Tuợng, ta có thể dùng class căn bản nhất là Object để "đa dạng hoá" ra một Object của class này.
    dim meDic as Object
    set meDic = CreateObject(….)
    Tuy cách này rất dễ dùng và không đòi hỏi phải reference đến Script Engine, nhưng nó là cách kêt nối trế – compiler chưa biết dạng cuối cùng của meDic cho nên mối lần đề cập đến meDic thì nó phải kết nối lại.

    Nếu dùng
    dim yoDic as Scipting.Dictionary
    set yoDic = New Scipting.Dictionary
    Thì sẽ sử dụng cách kết nối sớm – compiler biết dạng cuối cùng của yoDic cho nên nó có thể kết nối trước.

    Thông thường thì cách kết nối sớm hữu hiệu (và có thể chạy nhanh) hơn cách nối trễ. Tuy nhiên, đối với VBA thì muốn kết nối sớm phải reference đến Scripting. Một ví dụ cho thấy một trong những trường hợp hy sinh tốc độ để đạt sự tổng quát.

    Với trình độ cùn của tôi thì chỉ cần mấy trang đầu là đủ học hỏi nhiều lắm rồi. Chỗ còn lại quá đặc thù cho nên tôi chả học được gì cả.

    Muốn học xa hơn thì nới rộng đề tài, hoặc lập một kỳ thi khác để giải những bài toán như thế này:

    [URL='https://www.giaiphapexcel.com/forum/showthread.php?89942-b%E1%BA%A3ng-t%E1%BB%95ng-h%E1%BB%A3p-nh%E1%BA%ADp-xu%E1%BA%A5t-t%E1%BB%93n'%5Dbảng tổng hợp nhập xuất tồn

    Đề bài: viết code sao cho chỉ cần chỉnh sửa 1 vài chỗ nhất định nào đó sẽ giải quyết được hết những loại bài toán như trên. Điểm được chấm theo: ví dụ số dòng cần sửa,…
    Những chỗ hardcode như có thể châm chước bằng cách tính "Replace All" như 2 dòng (1 dòng là code cũ, 1 dòng là code mới)
    Những chô cần chỉnh sửa phải được ghi chú. Nếu không ghi ra thì coi như chạy sai.
    Code nào không có ghi chú những chỗ cần chỉnh sửa thì coi như không cần chỉnh sửa.

    Đang đợi các thành viên khác viết xem để học hỏi thêm, tuy nhiên chưa thấy bài nào, mình xin mở đầu, như các bạn cũng đã biết tốc độ của nó sẽ kém hơn nhiều, nhưng ADO cũng là 1 giải pháp. Mong các bạn cải thiện để code ngày càng nhanh hơn.

    Sub LapSo()
        Dim cn As Object, rst As Object, strNgay1 As String, strNgay2 As String
        Dim mySQL As String
        Set cn = CreateObject("ADODB.Connection")
        Set rst = CreateObject("ADODB.Recordset")
        strNgay1 = Format(Range("Ngay1"), "MM-dd-yyyy")
        strNgay2 = Format(Range("Ngay2"), "MM-dd-yyyy")
        With cn
          .Provider = "Microsoft.Jet.OLEDB.4.0"
          .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                              "Data Source=" & ThisWorkbook.FullName & _
                              ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
          .Open
        End With
        mySQL = "SELECT KHO.MA_VLSPHH, DMVLSPHH.TEN, DMVLSPHH.DVI, " & _
                    "Sum(IIf([kho].[Ngay_CT]<#" & strNgay1 & "# And [kho].[loai_phieu]='N',[KHO].[SLG],0)-IIf([kho].[ngay_ct]<#" & strNgay1 & "# And [kho].[LOAI_PHIEU]='X',[KHO].[SLG],0)) AS TONDK, " & _
                    "Sum(IIf([kho].[Ngay_CT]<#" & strNgay1 & "# And [kho].[loai_phieu]='N',[KHO].[THANH_TIEN],0)-IIf([kho].[ngay_ct]<#" & strNgay1 & "# And [kho].[LOAI_PHIEU]='X',[KHO].[THANH_TIEN],0)) AS TTDK, " & _
                    "Sum((IIf([kho].[ngay_ct] Between #" & strNgay1 & "# And #" & strNgay2 & "# And [LOAI_PHIEU]='N',[KHO].[SLG],0))) AS NHAP, " & _
                    "Sum((IIf([kho].[Ngay_CT] Between #" & strNgay1 & "# And #" & strNgay2 & "# And [LOAI_PHIEU]='N',[KHO].[THANH_TIEN],0))) AS TTNHAP, " & _
                    "Sum((IIf([kho].[ngay_ct] Between #" & strNgay1 & "# And #" & strNgay2 & "# And [kho].[LOAI_PHIEU]='X',[KHO].[SLG],0))) AS XUAT, " & _
                    "Sum((IIf([kho].[ngay_ct] Between #" & strNgay1 & "# And #" & strNgay2 & "# And [kho].[LOAI_PHIEU]='X',[KHO].[THANH_TIEN],0))) AS TTXUAT, " & _
                    "[TONDK]+[NHAP]-[XUAT] AS TONCK, " & _
                    "[TTDK]+[TTNHAP]-[TTXUAT] AS TTCUOI " & _
                "FROM KHO INNER JOIN DMVLSPHH ON KHO.MA_VLSPHH = DMVLSPHH.MA_VLSPHH " & _
                "GROUP BY KHO.MA_VLSPHH, DMVLSPHH.TEN, DMVLSPHH.DVI"
        Set rst = cn.Execute(mySQL)
        With Sheets("THNXT")
            .[C12:M23].ClearContents
            .[C12].CopyFromRecordset rst
        End With
        rst.Close: cn.Close
        Set rst = Nothing: Set cn = Nothing
    
    End Sub

    Thử với 1 triệu dòng, có khi đây là giải pháp tốt hơn! Khả năng chậm là do thời gian kết nối.

    Em nghĩ nó sẽ không đáng kể, nó tốn thời gian nhiều là chổ group để cộng.

    Reply
12. hands says:

    30/01/2023 at 1:34 pm

    Tôi không có đủ tài nguyên để chạy thử. Chỉ nhìn tổng quan trên code SQL.

    1. Hình như code không đảm bảo giữ được thứ tự của mã hàng trước và sau khi tổng kết.

    2. Bác thử chọn các dòng date2 kể về trước cho kho xem có cải tiến tốc độ không?

    " FROM KHO INNER JOIN DMVLSPHH ON KHO.MA_VLSPHH = DMVLSPHH.MA_VLSPHH " & _
    " AND KHO. <= #" & strNgay2 & "# " & _
    " GROUP BY KHO.MA_VLSPHH, DMVLSPHH.TEN, DMVLSPHH.DVI"

    (Nếu chọn trước thì phần IIF ở trên chỉ cần so với strNgay1 thôi chứ không cần phải so với strNgay2 nữa)

    Mẹo nhỏ: trong cái string câu lệnh SQL, mỗi lần xuống dòng mới nguời ta chừa một khoảng trắng. Như vậy tránh được lỗi thường gặp khi quên chừa khoảng trắng ở dòng trước đó.

    HLMT có chừa khoảng trắng cuối dòng mà VetMini? Vã lại, khi có thói quen trước hay sau, thì người ta sẽ không quên quá trình mình thực hiện được đâu.

    Đây không phải là mẹo của riêng tôi. Tất cả những người chuyên viết string SQL động (dynamic sql string) đều biết mẹo này:
    – Luôn luôn thêm một khoảng trống trước cái string được nối thêm, trừ phi thêm như thế gây ra việc ngắt từ.

    ====== Bổ sung thêm:

    …khi có thói quen trước hay sau, thì người ta sẽ không quên quá trình mình thực hiện được đâu…

    Câu này không áp dụng được đối với người chuyên copy code về chỉnh sửa lại. Như tôi chẳng hạn.

    " AND KHO. <= #" & strNgay2 & "# " & _

    Chưa thử nhưng hình như nó có gì đó khộng ổn.
    Cải tiến lại chút khi chọn khoảng thời gian, chỉ lấy những mặt hàng trong khoảng thời gian thoả điều kiện, tốc độ tuỳ thuộc vào dữ liệu trong khoảng thời gian đó nhiều hay ít. Tuy nhiên tốc độ cũng chưa được ưng ý. Nhờ các bạn cải tiến thêm.

    Sub LapSo()
        Dim cn As Object, rst As Object, strNgay1 As String, strNgay2 As String
        Dim mySQL As String
        Set cn = CreateObject("ADODB.Connection")
        Set rst = CreateObject("ADODB.Recordset")
        strNgay1 = Format(Range("Ngay1"), "MM-dd-yyyy")
        strNgay2 = Format(Range("Ngay2"), "MM-dd-yyyy")
        With cn
          .Provider = "Microsoft.Jet.OLEDB.4.0"
          .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                              "Data Source=" & ThisWorkbook.FullName & _
                              ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
          .Open
        End With
        mySQL = "SELECT A.MA_VLSPHH, DMVLSPHH.TEN, DMVLSPHH.Dvi, " & _
                "Sum((IIf([kho].[Ngay_CT]<#" & strNgay1 & "# And [kho].[loai_phieu]='N',[KHO].[SLG],0)-IIf([kho].[ngay_ct]<#" & strNgay1 & "# And [kho].[LOAI_PHIEU]='X',[KHO].[SLG],0))) AS TONDK, " & _
                "Sum((IIf([kho].[Ngay_CT]<#" & strNgay1 & "# And [kho].[loai_phieu]='N',[KHO].[THANH_TIEN],0)-IIf([kho].[ngay_ct]<#" & strNgay1 & "# And [kho].[LOAI_PHIEU]='X',[KHO].[THANH_TIEN],0))) AS TTDK, " & _
                "Sum((IIf([kho].[ngay_ct]>=#" & strNgay1 & "# And [LOAI_PHIEU]='N',[KHO].[SLG],0))) AS NHAP, " & _
                "Sum((IIf([kho].[Ngay_CT]>=#" & strNgay1 & "# And [LOAI_PHIEU]='N',[KHO].[THANH_TIEN],0))) AS TTNHAP, " & _
                "Sum((IIf([kho].[ngay_ct]>=#" & strNgay1 & "# And [kho].[LOAI_PHIEU]='X',[KHO].[SLG],0))) AS XUAT, " & _
                "Sum((IIf([kho].[ngay_ct]>=#" & strNgay1 & "# And [kho].[LOAI_PHIEU]='X',[KHO].[THANH_TIEN],0))) AS TTXUAT, " & _
                "[TONDK]+[NHAP]-[XUAT] AS TONCK, " & _
                "[TTDK]+[TTNHAP]-[TTXUAT] AS TTCUOI " & _
                "FROM (SELECT KHO.NGAY_CT, KHO.MA_VLSPHH, KHO.LOAI_PHIEU, KHO.SLG, KHO.THANH_TIEN " & _
                      "FROM KHO " & _
                      "WHERE KHO.NGAY_CT<=#" & strNgay2 & "#) AS A " & _
                "INNER JOIN DMVLSPHH ON A.MA_VLSPHH = DMVLSPHH.MA_VLSPHH " & _
                "GROUP BY A.MA_VLSPHH, DMVLSPHH.TEN, DMVLSPHH.Dvi"
        Set rst = cn.Execute(mySQL)
        With Sheets("THNXT")
            .[C12:M23].ClearContents
            .[C12].CopyFromRecordset rst
        End With
        rst.Close: cn.Close
        Set rst = Nothing: Set cn = Nothing
    
    End Sub

    Tôi cũng chưa thử. Chỉ dùng trên nguyên tắc thêm một điều kiện vào trong mệnh đề JOIN để nó tự lọc. Cái này dùng được cho TSQL nhưng tôi chưa thử được trên Access nên chưa biết.

    1. Lúc thêm cái subquery;
    "FROM (SELECT KHO.NGAY_CT, KHO.MA_VLSPHH, KHO.LOAI_PHIEU, KHO.SLG, KHO.THANH_TIEN " & _
    "FROM KHO " & _
    "WHERE KHO.NGAY_CT<=#" & strNgay2 & "#) AS A " & _

    Nếu bạn dùng "AS " thì sẽ không phải chỉnh sửa các phần tên tự (alias) ở những chỗ khác.

    2. Nếu trong khoảng thời gian trên mã hàng nào không có biến dộng thì nó sẽ bị mất. Thông thường thì báo cáo người ta phải báo cáo đầy đủ. Trường hợp này thì dùng RIGHT OUTER JOIN hữu lý hơn. Tôi chỉ nói theo thông lệ báo cáo, nhưng hình như đề bài chỉ báo cáo những mặt hàng có biến động cho nên dùng INNER JOIN như bạn là đúng rồi.

    2. Nếu trong khoảng thời gian trên mã hàng nào không có biến dộng thì nó sẽ bị mất. Thông thường thì báo cáo người ta phải báo cáo đầy đủ. Trường hợp này thì dùng RIGHT OUTER JOIN hữu lý hơn. Tôi chỉ nói theo thông lệ báo cáo, nhưng hình như đề bài chỉ báo cáo những mặt hàng có biến động cho nên dùng INNER JOIN như bạn là đúng rồi.

    Tôi đã biết vấn đề này, tuy nhiên theo yêu cầu đề tài cũng như "tăng tốc" khi chạy code nên tôi đã không dùng nó. Còn nếu như dùng nó thì tốc độ cũng sẽ bị giảm đi đó.

    Còn về vấn đề "không đảm bảo trật tự của mã hàng trong bảng mẫu báo cáo trước khi tổng hợp" như tôi đã nêu ra trước đây là đúng hay sai? Nếu đúng thì bạn có cách khắc phục chưa?

    Ở đây nó sẽ tự sắp xếp theo thứ tự tăng dần, theo bạn thì phải sắp xếp như thế nào mới hợp lý.

    Với giải pháp dùng SQL ta không tính thời gian kết nối CSDL:

    1. Kết nối CSDL Excel
    -> Thời gian bắt đầu
    2. Thực thi SQL, nhận Recordset
    3. Điền dữ liệu vào bảng tính
    -> Thời gian kết thúc

    Reply
13. hands says:

    30/01/2023 at 1:36 pm

    Với giải pháp dùng SQL ta không tính thời gian kết nối CSDL:

    1. Kết nối CSDL Excel
    -> Thời gian bắt đầu
    2. Thực thi SQL, nhận Recordset
    3. Điền dữ liệu vào bảng tính
    -> Thời gian kết thúc

    –> Ta có thể tạo thêm 1 sub kết nối dữ liệu bên ngoài, khi cần kết nối lại ta có thể kết nối lại. Dùng cách này sẽ bỏ qua kết nối khi mỗi lần chạy code lần sau.

    Như em đã nhiều lần đưa ra ý kiến ở trên, với việc tổng hợp = ADO trên cùng file thì tốc độ sẽ thua, nhưng nếu file data từ 1 file khác thì chưa chắc đã qua ADO.

    HLMT đã cho vào test thực sự chưa, vì test thấy code sẽ lỗi, Lỗi do thiếu chỉ ra địa chỉ cho KHO, DMVLSPHH hay ở file của HLMT thì có đặt gì thêm???

    Name theo file anh Tuân gửi đó anh2572

    File tôi test cũng có các name đó, nhưng báo lỗi muốn chạy thì phải gán địa chỉ vào hay excel2010 không cho vậy???

    Còn việc nếu database ở file khác – khi đó cũng không tính kết nối (mở file) thì ADO cũng khó theo kịp, có lẽ vì đặc thù là ngoại vụ của Excel,

    Tuy vậy với bài này tốc độ ADO vẫn chấp nhận được, và lồng SQL thì có cái hay nhất là gửi lệnh thực thi (SQL) theo string, nên nếu mở rộng thì dễ thay đổi, hay cho người dùng cuối có thể tự chọn kết quả mong muốn, thông qua đưa sql string

    Em cũng sử dụng O2010 đây mà anh.

    Với file này chạy được rồi, tốc độ khoảng 2300 mls (ở tại lap của tôi), thực tế thế là tốc độ chấp nhận được (chớp mắt 2 lần) + code theo ADO với SQL thế này code sáng và ngắn gọn (dĩ nhiên với người biết SQL)

    Tôi test kết nối thì không mất đáng kể đâu khoảng 7-10mls cho kết nối mà thôi, như vậy có lẽ thời gian thực thi SQL mới là vấn đề — vì xét cho cùng thì (1) thực hiện SQL là ngoại vụ, (2) bản thân SQL cũng phải dịch ngôn ngữ của chính nó (như thế VBA là thứ cấp, qua SQL lại là thứ cấp lần nữa) – nên tiêu tốn thời gian ở đây (nếu lệnh SQL càng yêu cầu thời gian như Groupby ở đây thì thời gian lại tăng thêm nữa)

    SQL là ngôn ngữ để làm việc trên CSDL Liên Hệ. Từ bản thân, CSDL LH vẫn có vấn đề về tốc độ.

    Khi dữ liệu được xếp chuẩn theo hàng cột để có thể sử dụng lý thuyết CSDL LH thì có những cái lợi sau đây:
    – Có thể thiết lập từ điển dữ liệu (data dictionary), tiếng tổng quát hơn gọi là hạ tầng dữ liệu (metadata)
    – Có thể tách biệt rõ 3 tầng (layers) truy xuất (data access), trình bày (presentation), và quy trình vận hành (business model)

    Nếu không chú trọng các lợi điểm trên thì sử dụng bảng tính theo kiểu CSDL LH chỉ tổ chạy chậm mà thôi. Khi ấy ADO chỉ có thể coi như một thủ thuật dùng để đọc/viết file mà không cần mở.

    …code sáng và ngắn gọn (dĩ nhiên với người biết SQL)…

    Kết luận như thế là hơi sớm.
    Muốn biết có gọn hay không thì phải export cái sheet data sang Access và dùng câu lệnh chạy thử. Kế đó chỉnh sửa cho đến lúc gọn ghẽ dễ trông nhất. Đôi khi phải hy sinh ngắn gọn để cho nó chạy nhanh. @HTMT: Access có công cụ đo hiệu quả câu lệnh không nhỉ?

    Ý sáng gọn ở đây, hiểu là nhìn nó ngắn và gọn hơn là viết code (thuần vba ví như array) để thực hiện việc lọc , group…. thế thui. Mà không bàn về cấu trúc lệnh sql đó,

    Đúng là code ngắn chưa hẳn là tối ưu, mà cần quan tâm kết quả cuối cùng và đạt mục đích

    Theo em cũng nên tính cả thời gian kết nối. Nếu file data là 1 file khác file chứa code thì tốc độ kết nối cũng như truy vấn sẽ nhanh hơn so với kết nối và truy vấn với data cùng 1 file?

    Nhờ anh chị em test dùm code sau xem tốc độ có được cải thiện thêm chút nào không? Chưa vừa ý lắm.

    Sub LapSo()
        Dim cn As Object, rst As Object, strNgay1 As String, strNgay2 As String
        Dim mySQL As String
        Set cn = CreateObject("ADODB.Connection")
        Set rst = CreateObject("ADODB.Recordset")
        strNgay1 = Format(Range("Ngay1"), "MM-dd-yyyy")
        strNgay2 = Format(Range("Ngay2"), "MM-dd-yyyy")
        With cn
          .Provider = "Microsoft.Jet.OLEDB.4.0"
          .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                              "Data Source=" & ThisWorkbook.FullName & _
                              ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
          .Open
        End With
        mySQL = "SELECT A.MA_VLSPHH, DMVLSPHH.TEN, DMVLSPHH.Dvi, " & _
                "Sum((IIf(a.[Ngay_CT]<#" & strNgay1 & "# And a.[loai_phieu]='N',a.[SLG],0)-IIf(a.[ngay_ct]<#" & strNgay1 & "# And a.[LOAI_PHIEU]='X',a.[SLG],0))) AS TONDK, " & _
                "Sum((IIf(a.[Ngay_CT]<#" & strNgay1 & "# And a.[loai_phieu]='N',a.[THANH_TIEN],0)-IIf(a.[ngay_ct]<#" & strNgay1 & "# And a.[LOAI_PHIEU]='X',a.[THANH_TIEN],0))) AS TTDK, " & _
                "Sum((IIf(a.[ngay_ct]>=#" & strNgay1 & "# And a.[LOAI_PHIEU]='N',a.[SLG],0))) AS NHAP, " & _
                "Sum((IIf(a.[Ngay_CT]>=#" & strNgay1 & "# And a.[LOAI_PHIEU]='N',a.[THANH_TIEN],0))) AS TTNHAP, " & _
                "Sum((IIf(a.[ngay_ct]>=#" & strNgay1 & "# And a.[LOAI_PHIEU]='X',a.[SLG],0))) AS XUAT, " & _
                "Sum((IIf(a.[ngay_ct]>=#" & strNgay1 & "# And a.[LOAI_PHIEU]='X',a.[THANH_TIEN],0))) AS TTXUAT, " & _
                "[TONDK]+[NHAP]-[XUAT] AS TONCK, " & _
                "[TTDK]+[TTNHAP]-[TTXUAT] AS TTCUOI " & _
                "FROM (SELECT KHO.NGAY_CT, KHO.MA_VLSPHH, KHO.LOAI_PHIEU, KHO.SLG, KHO.THANH_TIEN " & _
                      "FROM KHO " & _
                      "WHERE KHO.NGAY_CT<=#" & strNgay2 & "#) AS A " & _
                "INNER JOIN DMVLSPHH ON A.MA_VLSPHH = DMVLSPHH.MA_VLSPHH " & _
                "GROUP BY A.MA_VLSPHH, DMVLSPHH.TEN, DMVLSPHH.Dvi "
        Set rst = cn.Execute(mySQL)
        With Sheets("THNXT")
            .[C12:M23].ClearContents
            .[C12].CopyFromRecordset rst
        End With
        rst.Close: cn.Close
        Set rst = Nothing: Set cn = Nothing
    
    End Sub

    Reply
14. hands says:

    30/01/2023 at 1:38 pm

    @HTMT: Access có công cụ đo hiệu quả câu lệnh không nhỉ?

    Đang chờ đợi bạn hướng dẫn sử dụng cái công cụ đó nè.

    Theo kỹ thuật tổng hợp thì bộ máy SQL sẽ dủng bảng index (đại khái gọi vậy, chứ là btree hay bảng băm, bảng gì thì là chuyện nội bộ của nó) để lọc GROUP. Và vì vậy kết quả sẽ ra theo thứ tự mã tăng dần (đây là hậu quả của kỹ thuật, chứ tiêu chuẩn không bắt buộc).

    Khi copy recordset trở lại vào sheet báo cáo thì cũng theo thứ tự này. Như vậy mẫu báo cáo sẽ có khả băng bị xáo trộn.

    Điểm rắc rối là theo chỗ tôi biết thì Access không có hàm đặt số thứ tự cho record.

    (@HLMT: xin lỗi tôi chỉ giải thích phần trên rườm rà cho những người mới học SQL)

    Nếu đề tài bắt phải giữ thứ tự của mẫu thì bắt buộc phải dựa vào cột A của bảng kết quả để sắp xếp. Cột này chứa số thứ tự của mã hàng.

    Quá lâu em lôi lại chủ đề này, không phải để thi gì đâu ạ. Các cách dùng Dictionary, Collection của các cao thủ đã là quá tuyệt vời rồi, tốc độ phải gọi là khủng khiếp.

    Vì thấy chủ để Power Query này hay quá, http://www.giaiphapexcel.com/diendan/threads/th%E1%BB%B1c-h%C3%A0nh-power-query-s%E1%BB%AD-d%E1%BB%A5ng-m-code-c%C4%83n-b%E1%BA%A3n-trong-k%E1%BA%BF-to%C3%A1n.153017/#post-1003719

    Chế từ bài #20 của lão chết tiệt @ptm0412 , e lấy bài của a @Nguyễn Duy Tuân và dùng giải pháp Power Query để giải bài tập của a Tuân xem sao.
    Kết quả để ở Sheet TongHop
    Code gốc của Anh Tuân để sheet THXNT.

    Rất mong các anh/chị vào góp ý thêm về cách làm, như em khởi tạo mấy Query thấy còn thô sơ quá.
    Em cảm ơn

    1. Tồn đầu kỳ tính thiếu: Dòng lệnh filter row chỉ tính nhập không tính xuất. Kết quả may là DateFrom là 1/8 chứ nếu 1/9 hay lớn hơn là sai. Từ ngày chuyển số tồn vào 31/7 đến ngày DateFrom chả lẽ chỉ nhập mà không xuất
    2577

    2. Nhiều query quá: 3 query sau gộp thành một

    2576

    3. Có thể gộp 4 dòng lệnh replace thành một

    ReplaceNull= Table.ReplaceValue(#"Removed Columns",null,0,Replacer.ReplaceValue,{"HH_TonDK.SLNhap","HH_TonDK.STienNhap","HH_Xuat.SLNhap","HH_Xuat.STienNhap"}),
        //#"Replaced Value" = Table.ReplaceValue(#"Removed Columns",null,0,Replacer.ReplaceValue,{"HH_TonDK.SLNhap"}),
        //#"Replaced Value1" = Table.ReplaceValue(#"Replaced Value",null,0,Replacer.ReplaceValue,{"HH_TonDK.STienNhap"}),
        //#"Replaced Value2" = Table.ReplaceValue(#"Replaced Value1",null,0,Replacer.ReplaceValue,{"HH_Xuat.SLNhap"}),
        //#"Replaced Value3" = Table.ReplaceValue(#"Replaced Value2",null,0,Replacer.ReplaceValue,{"HH_Xuat.STienNhap"}),

    4. Đặt tên column dỏm: Query HH_Xuat mà tên cột là nhập

    2575

    Query HH_Xuat mà tên cột là nhập

    Em rất cảm ơn bác Phù Thủy,
    Bám theo các góp ý của bác, e có sửa lại các Query.

    Ngoài ra, e cũng muốn hỏi thêm 1 í nữa, sau khi click thực hiện thì lệnh Refresh Query được thực hiện.
    Theo cấu trúc sau khi refresh xong thì Background Query mới chạy.
    Mà dòng lệnh đo thời gian chỉ đo khi lệnh refresh thực hiện xong, mà e muốn đo cả thời gian Background Query thì cú pháp phải thay đổi như thế nào ạ?

    Em cảm ơn,

    Sửa xong nhưng lòi ra cái sai chết người (hên là đúng do dữ liệu ẹ quá)
    1. Cái sai chết người:
    – HHTonDK chỉ join 2 query nhập và xuất, không join bảng danh mục, nên không thấy những mặt hàng không nhập xuất
    – 2 query nhập đầu kỳ và xuất trong kỳ lại join kiểu left outer, thì chỉ những mặt hàng có nhập có xuất và có nhập không xuất mới được lấy, mặt hàng không nhập có xuất không được lấy => đầu kỳ sai
    2. Dữ liệu ẹ:
    – suốt 1 năm rưỡi mà chỉ thấy nhập xuất ở 4 tháng, trong đó 3 tháng chỉ có mỗi tháng 1 ngày. Không test theo kiểu nối đuôi được (là test 1 khoảng thời gian bất kỳ, lấy cuối kỳ, test tiếp khoảng thời gian liền kề đối chiếu đầu kỳ này và cuối kỳ trước
    – Suốt từ 1/8/2005 đến 31/7/2006 chỉ mua bán 4 mặt hàng, nguyên tháng 8/ 2006 thêm được 2 mặt hàng nữa. Đây chính là lý do dù có left join, right join, full join, inner join kiểu gì trước ngày 1 tháng 8/2006 cũng không sai kiểu thiếu mặt hàng.

    e muốn đo cả thời gian Background Query thì cú pháp phải thay đổi như thế nào ạ?

    Tỷ tỷ không biết rành VBA đâu, hỏi mấy lão cao thủ cao nhơn á. Có điều trong khi test thấy chậm lắm, đừng đo cho xấu hổ

    Em cảm ơn Tỷ tỷ, bộ môn này mới quá, em mới thử làm. Ngôn ngữ nhìn cũng khó nhằn, thấy cứ join được là join đã. Có lẽ phải xin dữ liệu test chuẩn hơn để làm ạ.

    Dữ liệu chuẩn đây nhé, 1 triệu dòng ngày tháng đầy đủ đã sắp xếp, mặt hàng 13 ngàn mua bán đều đặn
    [URL='www.giaiphapexcel.com/diendan/threads/t%E1%BA%A1o-s%E1%BB%95-th-nxt-v%E1%BB%9Bi-t%E1%BB%91c-%C4%91%E1%BB%99-nhanh-nh%E1%BA%A5t-d%E1%BB%AF-li%E1%BB%87u-h%C6%A1n-1-tri%C3%AA%CC%A3u-d%C3%B2ng.90062/']Dữ liệu mẫu 1 triệu dòng

    Reply