Sử dụng dictionary VBA để tính tồn kho

Liên hệ QC

moihocvba

Thành viên thường trực
Tham gia
16/8/20
Bài viết
207
Được thích
49
Xin chào anh chị GPE!

Em đang cần tính TỒN KHO của kho dựa vào dữ liệu đầu vào: TỒN KHO = SL Tồn đầu (cột E sheet ListHang) + Nhập kho (Cột D sheet NhapKho) - Xuất Kho (Cột D sheet XuatKho)

Để tính cái này thì dùm SUMIFS nó cũng ra được, nhưng vì dữ liệu của em lớn (10.000 mã hàng và hàng trăm ngàn dòng nhập xuất nên mỗi lần nhập liệu hoặc tra cứu thì excel phải tính lại nên rất lâu và file sẽ nặng), với em rất thường tra cứu tồn kho nên dùng sumif trong vba đưa ra tính toán cũng chậm.

Nên em muốn nhờ anh chị giúp em thuật toán đưa dữ liệu vào mảng rồi dùng dictionary để tính toán sau đó đưa dữ liệu ra sheet tồn được không ạ? Vì em nghe nói cách này tính toán rất nhanh với khối lượng dữ liệu lớn. Em cũng đang học về VBA dictionary nên cũng muốn tham khảo cách tối ưu nhất.

Xin cảm ơn anh chị rất nhiều! Em có gửi file đính kèm ạ! File này em trích ra ví dụ thôi, chứ file thực tế em nhiều sheet hơn nữa, nên hơi nặng.

Bổ sung: Em lấy Tên hàng làm giá trị duy nhất ạ (Mã hàng ko bắt buộc)
 

File đính kèm

  • NhapXuatTon.xlsm
    2.7 MB · Đọc: 73
Lần chỉnh sửa cuối:
Có cả không tồn không nhập mà xuất!
Có khi nhận hàng khuyến mãi không nhập kho, hàng trả về không xử lý... Khi xuất thì sẽ bị âm.
Em thử viết tạm bằng ADO, không loại bỏ hàng bị âm như sau:

SQL:
Sub LayDL()
    Dim strSQL As String
    strSQL = strSQL & "SELECT F2 AS Ten, " & vbCrLf
    strSQL = strSQL & "       F3 AS DVT, " & vbCrLf
    strSQL = strSQL & "       F5 AS SoLg " & vbCrLf
    strSQL = strSQL & "FROM   [LISTHANG$A5:E] " & vbCrLf
    strSQL = strSQL & "UNION ALL " & vbCrLf
    strSQL = strSQL & "SELECT F2 AS Ten, " & vbCrLf
    strSQL = strSQL & "       F3 AS DVT, " & vbCrLf
    strSQL = strSQL & "       F4 AS SoLg " & vbCrLf
    strSQL = strSQL & "FROM   [NHAPKHO$A3:E] " & vbCrLf
    strSQL = strSQL & "UNION ALL " & vbCrLf
    strSQL = strSQL & "SELECT F2  AS Ten, " & vbCrLf
    strSQL = strSQL & "       F3  AS DVT, " & vbCrLf
    strSQL = strSQL & "       -F4 AS SoLg " & vbCrLf
    strSQL = strSQL & "FROM   [XUATKHO$A3:E]"
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No"""
        Sheet5.Range("B5").CopyFromRecordset .Execute("Select Ten,DVT,Sum(SoLg) From(" & strSQL & ") Group By Ten,DVT")
    End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Coi như có 2 loại phát sinh chính: loại tồn đầu coi như nhập, loại nhập, và loại xuất.
Và 1 loại phát sinh đặc bệt: loại nhập/xuất mà chưa có tên trong danh mục coi như là loại phát sinh tạo danh mục.

Join: bạn không dùng Join mà dùng Union All và Group.
Tôi thích làm việc với dữ liệu chuẩn CSDL: có bảng mã (nếu không có mã mà dùng tên thì cũng phải chuẩn), chưa có mã thì không cho nhập xuất, nhập xuất phải ràng buộc từ bảng mã.
Khi tôi viết Dict ở trên cũng viết theo chuẩn, lỗi chưa có mã tôi lọc ra cho thấy mà sửa, khi nào sửa xong mà msgbox báo số lượng mã lỗi bằng 0 thì thôi. Còn viết như ý anh là chữa cháy và dung túng cái sai. Các cái sai không chỉ là lỗi chưa có mã mà còn bao gồm cả lỗi đánh máy, lỗi chính tả, và lỗi gõ ẩu.
 
Upvote 0
Code viết đơn giản cho dễ hiểu. Phát hiện 1824 mặt hàng không có trong list nhưng có nhập xuất. Đó là cái tội không dùng mã hàng mà dùng tên cho gõ sai.
PHP:
Sub TinhTon()
Dim LastRw As Long, SArr(), RArr(), Dict1, NaArr(1 To 20000, 1 To 1)
Dim i As Long, k As Long, Na As Long, Item As String
Application.ScreenUpdating = False
Set Dict1 = CreateObject("Scripting.Dictionary")
With Sheet3 '(List hang)'
    LastRw = .[B20000].End(xlUp).Row
    SArr = .Range("B5:E" & LastRw).Value2
ReDim RArr(1 To UBound(SArr, 1), 1 To 3)
    For i = 1 To UBound(SArr, 1)
        Dict1.Add SArr(i, 1), i
        RArr(i, 1) = SArr(i, 1)
        RArr(i, 2) = SArr(i, 2)
        RArr(i, 3) = SArr(i, 4)
    Next
End With

With Sheet4 '(Nhap kho)'
    LastRw = .[B500000].End(xlUp).Row
    SArr = .Range("B3:D" & LastRw).Value2
    For i = 1 To UBound(SArr, 1)
        Item = SArr(i, 1)
        If Dict1.exists(Item) Then
            k = Dict1.Item(Item)
            RArr(k, 3) = RArr(k, 3) + SArr(i, 3)
        Else
            Na = Na + 1
            NaArr(Na, 1) = Item
        End If
    Next
End With
With Sheet1 '(Xuat kho)'
    LastRw = .[B500000].End(xlUp).Row
    SArr = .Range("B3:D" & LastRw).Value2
    For i = 1 To UBound(SArr, 1)
        Item = SArr(i, 1)
        If Dict1.exists(Item) Then
            k = Dict1.Item(Item)
            RArr(k, 3) = RArr(k, 3) - SArr(i, 3)
        Else
            Na = Na + 1
            NaArr(Na, 1) = Item
        End If
    Next
End With
With Sheet5 '(Ton kho)'
    .Range("B5:F20000").Clear
    .[B5].Resize(Dict1.Count, 3).Value = RArr
    .[F5].Resize(Na, 1).Value = NaArr
    .[F5].Resize(Na, 1).RemoveDuplicates Columns:=1, Header:=xlNo
    Na = Application.CountA(.[F5:F20000])
End With
Application.ScreenUpdating = True
MsgBox "There are " & Na & " item(s) not available but have been transfered", , "ptm0412"

End Sub
Con cám ơn chú ptm0412, con đã áp dụng cách của chú và thấy code chạy rất nhanh (khoảng 0.2 giây), nó là điều tuyệt vời con đang cần.
Con chúc chú sức khỏe và giúp đỡ được nhiều bạn giống con ạ!
Bài đã được tự động gộp:

Có khi nhận hàng khuyến mãi không nhập kho, hàng trả về không xử lý... Khi xuất thì sẽ bị âm.
Em thử viết tạm bằng ADO, không loại bỏ hàng bị âm như sau:

SQL:
Sub LayDL()
    Dim strSQL As String
    strSQL = strSQL & "SELECT F2 AS Ten, " & vbCrLf
    strSQL = strSQL & "       F3 AS DVT, " & vbCrLf
    strSQL = strSQL & "       F5 AS SoLg " & vbCrLf
    strSQL = strSQL & "FROM   [LISTHANG$A5:E] " & vbCrLf
    strSQL = strSQL & "UNION ALL " & vbCrLf
    strSQL = strSQL & "SELECT F2 AS Ten, " & vbCrLf
    strSQL = strSQL & "       F3 AS DVT, " & vbCrLf
    strSQL = strSQL & "       F4 AS SoLg " & vbCrLf
    strSQL = strSQL & "FROM   [NHAPKHO$A3:E] " & vbCrLf
    strSQL = strSQL & "UNION ALL " & vbCrLf
    strSQL = strSQL & "SELECT F2  AS Ten, " & vbCrLf
    strSQL = strSQL & "       F3  AS DVT, " & vbCrLf
    strSQL = strSQL & "       -F4 AS SoLg " & vbCrLf
    strSQL = strSQL & "FROM   [XUATKHO$A3:E]"
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No"""
        Sheet5.Range("B5").CopyFromRecordset .Execute("Select Ten,DVT,Sum(SoLg) From(" & strSQL & ") Group By Ten,DVT")
    End With
End Sub
Dạ, Chào chú Hai Lúa Miền Tây, cám ơn chú đã giúp con!
Con chưa biết gì về ADO nên con không biết chỉnh sửa code của chú như thế nào để phù hợp với file của con. Con sẽ lưu code của chú lại, sau này con học thêm ADO sẽ nghiên cứu tiếp!
Chúc chú luôn vui vẻ ạ!
 
Upvote 0
Con cám ơn chú ptm0412, con đã áp dụng cách của chú và thấy code chạy rất nhanh (khoảng 0.2 giây), nó là điều tuyệt vời con đang cần.
Con chúc chú sức khỏe và giúp đỡ được nhiều bạn giống con ạ!
Quan trọng là phải chuẩn hoá dữ liệu:
- Nên có mã và có bảng mã đầy đủ
- Chưa có mã chưa cho nhập xuất
- Nhập xuất dùng mã, và kiểm soát được việc gõ sai chính tả, dư khoảng trắng, sai chính tả

Sửa xong chạy code cho đến khi thông báo không còn mặt hàng lỗi
 
Upvote 0
Quan trọng là phải chuẩn hoá dữ liệu:
- Nên có mã và có bảng mã đầy đủ
- Chưa có mã chưa cho nhập xuất
- Nhập xuất dùng mã, và kiểm soát được việc gõ sai chính tả, dư khoảng trắng, sai chính tả

Sửa xong chạy code cho đến khi thông báo không còn mặt hàng lỗi
Dạ, con đang từng bước hoàn chỉnh đó chú, hồi giờ cậu mợ làm theo kiểu tùy ý, giờ con nhìn lại cũng thấy hoảng, con cần có thời gian để điều chỉnh dần dần. Làm được nhiều điều nên con dần nghiền VBA rồi chú, hihi
 
Upvote 0
Dạ, con đang từng bước hoàn chỉnh đó chú, hồi giờ cậu mợ làm theo kiểu tùy ý, giờ con nhìn lại cũng thấy hoảng, con cần có thời gian để điều chỉnh dần dần. Làm được nhiều điều nên con dần nghiền VBA rồi chú, hihi
Không, Từng bước từng bước thì đúng rồi
Song, từng bước thì không thể nhày bước
Bước đầu tiên là chuẩn hóa dữ liệu - như các thành viên trên đã nói, thì không nên bỏ qua
Bỏ qua thì làm khó mình và khó các bước sau
Nếu Bước sau lại làm trước bước chuẩn hóa đó, thì sau sửa sẽ lại sửa từ đầu
 
Upvote 0
Tác giả yêu cầu là:


Nên ADO hay Power Query là cái chi chi...???
Tôi tưởng lâu ngày bạn đã biết tính tôi.
Phần lớn bài của tôi là giới thiệu thuật toán và phương pháp cho các bạn có nhu cầu. Nếu tôi viết code thì thường là chỉ minh hoạ thuật toán.
Việc của các chủ thớt đối với tôi thường là chữa cháy; chỉ sử dụng được một trường hợp duy nhất; cả thuật toán lẫn code.

Chủ yếu bài này là thớt bước vào lập trình mà đã có định kiến và thành kiến về giải thuật; cho rằng dictionary là cái chìa khoá vạn năng. Với những người đã có thành kiến tôi không buồn lý luận. Tôi chỉ vạch rõ các chọn lựa cho những thành viên khác thôi.
Rất có thể với dạng dữ liệu tum lùm như bào này, Power Query sẽ phải văn vẹo đủ điều, và cũng có thể ADO không khả thi. Nhưng chưa thử tư duy, tính toán các giải trình thì sao biết?

Tôi thích làm việc với dữ liệu chuẩn CSDL: có bảng mã (nếu không có mã mà dùng tên thì cũng phải chuẩn), chưa có mã thì không cho nhập xuất, nhập xuất phải ràng buộc từ bảng mã.
Khi tôi viết Dict ở trên cũng viết theo chuẩn, lỗi chưa có mã tôi lọc ra cho thấy mà sửa, khi nào sửa xong mà msgbox báo số lượng mã lỗi bằng 0 thì thôi. Còn viết như ý anh là chữa cháy và dung túng cái sai. Các cái sai không chỉ là lỗi chưa có mã mà còn bao gồm cả lỗi đánh máy, lỗi chính tả, và lỗi gõ ẩu.
Như tôi đã giải thích ở bài trước. Đối với công việc Inventory Control, có những hệ thống chấp nhận phát sinh không có sẵn mã hàng. Lúc gộp phát sinh về mới lập record trong master file, mà cũng chỉ là record tạm (chi tiết chỉ có thể lấy từ phát sinh đâu có nhiều). Người quản lý sau đó mới vào record tạm này mà chỉnh sửa thành record đầy đủ (những chi tiết còn lại).

...Nếu Bước sau lại làm trước bước chuẩn hóa đó, thì sau sửa sẽ lại sửa từ đầu
Làm việc với dữ liệu chưa chuẩn cũng được. Nhưng đòi hỏi phải có rất nhiều kinh nghiệm về dạng dữ liệu, và kiến thức về toán thống kê. Và tôi nhấn mạnh từ "rất nhiều" trong "rất nhiều kinh nghiệm".
 
Upvote 0
Tôi tưởng lâu ngày bạn đã biết tính tôi.
Phần lớn bài của tôi là giải thích thuật toán và phương pháp cho các bạn có nhu cầu.
Việc của các chủ thớt đối với tôi thường là chữa cháy; chỉ sử dụng được một trường hợp duy nhất; cả thuật toán lẫn code.

Chủ yếu bài này là thớt bước vào lập trình mà đã có định kiến và thành kiến về giải thuật; cho rằng dictionary là cái chìa khoá vạn năng. Với những người đã có thành kiến tôi không buồn lý luận. Tôi chỉ vạch rõ các chọn lựa cho những thành viên khác thôi.
Rất có thể với dạng dữ liệu tum lùm như bào này, Power Query sẽ phải văn vẹo đủ điều, và cũng có thể ADO không khả thi. Nhưng chưa thử tư duy, tính toán các giải trình thì sao biết?
Biết chứ Anh, tại thấy lâu lâu anh nhắc đến ADO nên cảm thấy hứng thú. Hỏi lại coi chủ thớt có cần hay không, ai dè hông có cần thiệt :D . Tuy nhiên viết thì cũng đã viết rồi, nếu ai khác cần thì cứ tham khảo thôi.
 
Upvote 0
Như tôi đã giải thích ở bài trước. Đối với công việc Inventory Control, có những hệ thống chấp nhận phát sinh không có sẵn mã hàng. Lúc gộp phát sinh về mới lập record trong master file, mà cũng chỉ là record tạm (chi tiết chỉ có thể lấy từ phát sinh đâu có nhiều). Người quản lý sau đó mới vào record tạm này mà chỉnh sửa thành record đầy đủ (những chi tiết còn lại).
Ờ thì tôi đã đồng ý "mã tạm" rồi, nguyên văn anh viết "loại nhập/xuất mà chưa có tên trong danh mục coi như là loại phát sinh tạo danh mục." và tôi đã đồng ý.
Riêng trong file của chủ đề này tôi viết thêm "còn bao gồm cả lỗi đánh máy, lỗi chính tả, và lỗi gõ ẩu". Và tôi không muốn "dung túng cái sai" là những cái sai loại này.
 
Upvote 0
Biết chứ Anh, tại thấy lâu lâu anh nhắc đến ADO nên cảm thấy hứng thú. Hỏi lại coi chủ thớt có cần hay không, ai dè hông có cần thiệt :D . Tuy nhiên viết thì cũng đã viết rồi, nếu ai khác cần thì cứ tham khảo thôi.
Không phải là ko cần ADO chú, mà chưa biết gì hết nên ko dám dùng, vì cần phải chỉnh sửa lại cho phù hợp với file, chứ con ko có dùng nguyên code này chú ạ!
Cám ơn chú nhiều!
 
Upvote 0
Web KT
Back
Top Bottom