Nhờ giúp tính tồn kho bằng Dictionary

Liên hệ QC
H

hanhpptc

Thành viên tiêu biểu
Tham gia
16/5/08
Bài viết
459
Được thích
320
Mình có đọc và học trên diễn đàn về Dic và thấy hay quá. Song khi áp dụng về mảng để tính xuất, nhập, tồn thì số liệu có sai. Mình biết là sai ở các phần thêm, sửa Item của Dic nhưng không tài nào chỉnh được. Mong các cao thủ trợ giúp. File VD đính kèm.
 

File đính kèm

  • NXT_Dic.xls
    55.5 KB · Đọc: 103
hanhpptc đã viết:
Mình có đọc và học trên diễn đàn về Dic và thấy hay quá. Song khi áp dụng về mảng để tính xuất, nhập, tồn thì số liệu có sai. Mình biết là sai ở các phần thêm, sửa Item của Dic nhưng không tài nào chỉnh được. Mong các cao thủ trợ giúp. File VD đính kèm.
Nhấp chuột vào đây để mở rộng...
Thử thay Sub của bạn bằng cái này thử xem:
PHP: 
Public Sub GPE()
Dim Rng1(), Rng2(), Rng3(), Arr(), I As Long, J As Long, K As Long, Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
    Rng1 = Sheets("DM").Range(Sheets("DM").[A2], Sheets("DM").[A65000].End(xlUp)).Resize(, 4).Value
    Rng2 = Sheets("Nhap").Range(Sheets("Nhap").[B2], Sheets("Nhap").[B65000].End(xlUp)).Resize(, 3).Value
    Rng3 = Sheets("Xuat").Range(Sheets("Xuat").[B2], Sheets("Xuat").[B65000].End(xlUp)).Resize(, 3).Value
ReDim Arr(1 To UBound(Rng1, 1), 1 To 8)
    For I = 1 To UBound(Rng1, 1)
        If Not Dic.exists(Rng1(I, 1)) Then
            K = K + 1
            Dic.Add Rng1(I, 1), K
                Arr(K, 1) = K: Arr(K, 8) = Rng1(I, 4)
                For J = 1 To 4
                    Arr(K, J + 1) = Rng1(I, J)
                Next
        End If
    Next I
        For I = 1 To UBound(Rng2, 1)
            If Dic.exists(Rng2(I, 2)) Then
                If Rng2(I, 1) >= Sheets("Bao Cao").[D2].Value And Rng2(I, 1) <= Sheets("Bao Cao").[D3].Value Then
                    Arr(Dic.Item(Rng2(I, 2)), 6) = Arr(Dic.Item(Rng2(I, 2)), 6) + Rng2(I, 3)
                    Arr(Dic.Item(Rng2(I, 2)), 8) = Arr(Dic.Item(Rng2(I, 2)), 8) + Rng2(I, 3)
                End If
            End If
        Next I
            For I = 1 To UBound(Rng3, 1)
                If Dic.exists(Rng3(I, 2)) Then
                    If Rng3(I, 1) >= Sheets("Bao Cao").[D2].Value And Rng3(I, 1) <= Sheets("Bao Cao").[D3].Value Then
                        Arr(Dic.Item(Rng3(I, 2)), 7) = Arr(Dic.Item(Rng3(I, 2)), 7) + Rng3(I, 3)
                        Arr(Dic.Item(Rng3(I, 2)), 8) = Arr(Dic.Item(Rng3(I, 2)), 8) - Rng3(I, 3)
                    End If
                End If
            Next I
        If K Then Sheets("Bao Cao").[A5].Resize(K, 8).Value = Arr
Set Dic = Nothing
End Sub
 
Ba Tê đã viết:
Thử thay Sub của bạn bằng cái này thử xem:
Nhấp chuột vào đây để mở rộng...
Cám ơn Ba Tê đã hướng dẫn, nhưng hình như phần hàng tồn đầu kỳ còn sai (Chương trình lấy đầu năm, chưa trừ phần nhập - xuất trước đó). Chọn kỳ báo cáo 15/01/2012 đến 31/01/2012 sẽ thấy.
 
Cám ơn bác Ba Tê nhiều. Mình đã chỉnh sửa Code theo hướng dấn của bác và đã giải quyết được vấn đề.
Sub GPE_Hanh()
Dim Rng1(), Rng2(), Rng3(), Arr(), I As Long, J As Long, K As Long, Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
Rng1 = Sheets("DM").Range(Sheets("DM").[A2], Sheets("DM").[A65000].End(xlUp)).Resize(, 4).Value
Rng2 = Sheets("Nhap").Range(Sheets("Nhap").[B2], Sheets("Nhap").[B65000].End(xlUp)).Resize(, 3).Value
Rng3 = Sheets("Xuat").Range(Sheets("Xuat").[B2], Sheets("Xuat").[B65000].End(xlUp)).Resize(, 3).Value
ReDim Arr(1 To UBound(Rng1, 1), 1 To 8)
For I = 1 To UBound(Rng1, 1)
If Not Dic.exists(Rng1(I, 1)) Then
K = K + 1
Dic.Add Rng1(I, 1), K
Arr(K, 1) = K: Arr(K, 8) = Rng1(I, 4)
For J = 1 To 4
Arr(K, J + 1) = Rng1(I, J)
Next
End If
Next I
For I = 1 To UBound(Rng2, 1)
If Dic.exists(Rng2(I, 2)) Then
If Rng2(I, 1) < Sheets("Bao Cao").[D2].Value Then
Arr(Dic.Item(Rng2(I, 2)), 5) = Arr(Dic.Item(Rng2(I, 2)), 5) + Rng2(I, 3)
Arr(Dic.Item(Rng2(I, 2)), 8) = Arr(Dic.Item(Rng2(I, 2)), 8) + Rng2(I, 3)
End If
If Rng2(I, 1) >= Sheets("Bao Cao").[D2].Value And Rng2(I, 1) <= Sheets("Bao Cao").[D3].Value Then
Arr(Dic.Item(Rng2(I, 2)), 6) = Arr(Dic.Item(Rng2(I, 2)), 6) + Rng2(I, 3)
Arr(Dic.Item(Rng2(I, 2)), 8) = Arr(Dic.Item(Rng2(I, 2)), 8) + Rng2(I, 3)
End If
End If
Next I
For I = 1 To UBound(Rng3, 1)
If Dic.exists(Rng3(I, 2)) Then
If Rng3(I, 1) < Sheets("Bao Cao").[D2].Value Then
Arr(Dic.Item(Rng3(I, 2)), 5) = Arr(Dic.Item(Rng3(I, 2)), 5) - Rng3(I, 3)
Arr(Dic.Item(Rng3(I, 2)), 8) = Arr(Dic.Item(Rng3(I, 2)), 8) - Rng3(I, 3)
End If
If Rng3(I, 1) >= Sheets("Bao Cao").[D2].Value And Rng3(I, 1) <= Sheets("Bao Cao").[D3].Value Then
Arr(Dic.Item(Rng3(I, 2)), 7) = Arr(Dic.Item(Rng3(I, 2)), 7) + Rng3(I, 3)
Arr(Dic.Item(Rng3(I, 2)), 8) = Arr(Dic.Item(Rng3(I, 2)), 8) - Rng3(I, 3)
End If
End If
Next I
If K Then Sheets("Bao Cao").[A5].Resize(K, 8).Value = Arr
Set Dic = Nothing
End Sub
 
hanhpptc đã viết:
Cám ơn Ba Tê đã hướng dẫn, nhưng hình như phần hàng tồn đầu kỳ còn sai (Chương trình lấy đầu năm, chưa trừ phần nhập - xuất trước đó). Chọn kỳ báo cáo 15/01/2012 đến 31/01/2012 sẽ thấy.
Nhấp chuột vào đây để mở rộng...
Thử lại với code này xem:
PHP: 
Public Sub GPE()
Dim Rng1(), Rng2(), Rng3(), Arr(), I As Long, J As Long, K As Long, Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
    Rng1 = Sheets("DM").Range(Sheets("DM").[A2], Sheets("DM").[A65000].End(xlUp)).Resize(, 4).Value
    Rng2 = Sheets("Nhap").Range(Sheets("Nhap").[B2], Sheets("Nhap").[B65000].End(xlUp)).Resize(, 3).Value
    Rng3 = Sheets("Xuat").Range(Sheets("Xuat").[B2], Sheets("Xuat").[B65000].End(xlUp)).Resize(, 3).Value
ReDim Arr(1 To UBound(Rng1, 1), 1 To 8)
    For I = 1 To UBound(Rng1, 1)
        If Not Dic.exists(Rng1(I, 1)) Then
            K = K + 1
            Dic.Add Rng1(I, 1), K
                Arr(K, 1) = K
                For J = 1 To 4
                    Arr(K, J + 1) = Rng1(I, J)
                Next
        End If
    Next I
        For I = 1 To UBound(Rng2, 1)
            If Dic.exists(Rng2(I, 2)) Then
                If Rng2(I, 1) < Sheets("Bao Cao").[D2].Value Then
                    Arr(Dic.Item(Rng2(I, 2)), 5) = Arr(Dic.Item(Rng2(I, 2)), 5) + Rng2(I, 3)
                ElseIf Rng2(I, 1) >= Sheets("Bao Cao").[D2].Value And Rng2(I, 1) <= Sheets("Bao Cao").[D3].Value Then
                    Arr(Dic.Item(Rng2(I, 2)), 6) = Arr(Dic.Item(Rng2(I, 2)), 6) + Rng2(I, 3)
                End If
            End If
        Next I
            For I = 1 To UBound(Rng3, 1)
                If Dic.exists(Rng3(I, 2)) Then
                    If Rng3(I, 1) < Sheets("Bao Cao").[D2].Value Then
                        Arr(Dic.Item(Rng3(I, 2)), 5) = Arr(Dic.Item(Rng3(I, 2)), 5) - Rng3(I, 3)
                    ElseIf Rng3(I, 1) >= Sheets("Bao Cao").[D2].Value And Rng3(I, 1) <= Sheets("Bao Cao").[D3].Value Then
                        Arr(Dic.Item(Rng3(I, 2)), 7) = Arr(Dic.Item(Rng3(I, 2)), 7) + Rng3(I, 3)
                    End If
                       Arr(Dic.Item(Rng3(I, 2)), 8) = Arr(Dic.Item(Rng3(I, 2)), 5) + Arr(Dic.Item(Rng3(I, 2)), 6) - Arr(Dic.Item(Rng3(I, 2)), 7)
                End If
            Next I
        If K Then Sheets("Bao Cao").[A5].Resize(K, 8).Value = Arr
Set Dic = Nothing
End Sub
 
Ba Tê đã viết:
Thử lại với code này xem:
PHP: 
Public Sub GPE()
Dim Rng1(), Rng2(), Rng3(), Arr(), I As Long, J As Long, K As Long, Dic As Object
' ...'        For I = 1 To UBound(Rng2, 1)
             If Dic.exists(Rng2(I, 2)) Then
...
            For I = 1 To UBound(Rng3, 1)
                If Dic.exists(Rng3(I, 2)) Then
Nhấp chuột vào đây để mở rộng...

Theo em nên cân nhắc dòng If Dic.exists(Rng2(I, 2)), vì theo như bài là tất cả mã hàng đều phải đăng ký vào DM.
Còn nhiều trường hợp nếu nhập hay xuất mà chưa có trong DM thì sẽ xử lý thêm nhiều hướng.
Công nhận Bác BaTê vận dụng Dic vào kế toán quá siêu.
 
Ba Tê đã viết:
Thử lại với code này xem:
PHP: 
Public Sub GPE()
..........
End Sub
Nhấp chuột vào đây để mở rộng...

Còn vấn đề này nữa, theo em nghĩ sẽ tăng tốc hơn:

Ta thêm 1 biến tmp rồi dùng biến tmp này thay thế Dic.Item(Rng3(i, 2))

Mã: 
            For i = 1 To UBound(Rng3, 1)
                If Dic.exists(Rng3(i, 2)) Then
                    [COLOR=#0000cd][B]tmp = Dic.Item(Rng3(i, 2))[/B][/COLOR]
                    If Rng3(i, 1) < Sheets("Bao Cao").[D2].Value Then
                        Arr([COLOR=#0000cd][B]tmp [/B][/COLOR], 5) = Arr([COLOR=#0000cd][B]tmp [/B][/COLOR], 5) - Rng3(i, 3)
                    ElseIf Rng3(i, 1) >= Sheets("Bao Cao").[D2].Value And _
                           Rng3(i, 1) <= Sheets("Bao Cao").[D3].Value Then
                        Arr([COLOR=#0000cd][B]tmp [/B][/COLOR], 7) = Arr([COLOR=#0000cd][B]tmp [/B][/COLOR], 7) + Rng3(i, 3)
                    End If
                    Arr([COLOR=#0000cd][B]tmp [/B][/COLOR], 8) = Arr([COLOR=#0000cd][B]tmp [/B][/COLOR], 5) + Arr([COLOR=#0000cd][B]tmp [/B][/COLOR], 6) - Arr([COLOR=#0000cd][B]tmp [/B][/COLOR], 7)
                End If
            Next i

Nghĩ thấy nó sẽ nhanh hơn vì không phải tính đến ít nhất 6 lần và code sẽ gọn gàng hơn.
 
Lần chỉnh sửa cuối:
Chào bác Ba Tê, em cũng có file tính tổng tương tự nhưng số cột cần tính nhiều hơn nên e vận dụng công thức của bàc vào chưa được. Cần bác giúp ạh
Bài đã được tự động gộp:

Ba Tê đã viết:
Thử lại với code này xem:
PHP: 
Public Sub GPE()
Dim Rng1(), Rng2(), Rng3(), Arr(), I As Long, J As Long, K As Long, Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
    Rng1 = Sheets("DM").Range(Sheets("DM").[A2], Sheets("DM").[A65000].End(xlUp)).Resize(, 4).Value
    Rng2 = Sheets("Nhap").Range(Sheets("Nhap").[B2], Sheets("Nhap").[B65000].End(xlUp)).Resize(, 3).Value
    Rng3 = Sheets("Xuat").Range(Sheets("Xuat").[B2], Sheets("Xuat").[B65000].End(xlUp)).Resize(, 3).Value
ReDim Arr(1 To UBound(Rng1, 1), 1 To 8)
    For I = 1 To UBound(Rng1, 1)
        If Not Dic.exists(Rng1(I, 1)) Then
            K = K + 1
            Dic.Add Rng1(I, 1), K
                Arr(K, 1) = K
                For J = 1 To 4
                    Arr(K, J + 1) = Rng1(I, J)
                Next
        End If
    Next I
        For I = 1 To UBound(Rng2, 1)
            If Dic.exists(Rng2(I, 2)) Then
                If Rng2(I, 1) < Sheets("Bao Cao").[D2].Value Then
                    Arr(Dic.Item(Rng2(I, 2)), 5) = Arr(Dic.Item(Rng2(I, 2)), 5) + Rng2(I, 3)
                ElseIf Rng2(I, 1) >= Sheets("Bao Cao").[D2].Value And Rng2(I, 1) <= Sheets("Bao Cao").[D3].Value Then
                    Arr(Dic.Item(Rng2(I, 2)), 6) = Arr(Dic.Item(Rng2(I, 2)), 6) + Rng2(I, 3)
                End If
            End If
        Next I
            For I = 1 To UBound(Rng3, 1)
                If Dic.exists(Rng3(I, 2)) Then
                    If Rng3(I, 1) < Sheets("Bao Cao").[D2].Value Then
                        Arr(Dic.Item(Rng3(I, 2)), 5) = Arr(Dic.Item(Rng3(I, 2)), 5) - Rng3(I, 3)
                    ElseIf Rng3(I, 1) >= Sheets("Bao Cao").[D2].Value And Rng3(I, 1) <= Sheets("Bao Cao").[D3].Value Then
                        Arr(Dic.Item(Rng3(I, 2)), 7) = Arr(Dic.Item(Rng3(I, 2)), 7) + Rng3(I, 3)
                    End If
                       Arr(Dic.Item(Rng3(I, 2)), 8) = Arr(Dic.Item(Rng3(I, 2)), 5) + Arr(Dic.Item(Rng3(I, 2)), 6) - Arr(Dic.Item(Rng3(I, 2)), 7)
                End If
            Next I
        If K Then Sheets("Bao Cao").[A5].Resize(K, 8).Value = Arr
Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...

Chào bác Ba Tê, em cũng có file tính tổng tương tự nhưng số cột cần tính nhiều hơn nên e vận dụng công thức của bàc vào chưa được. Cần bác giúp ạh
 

File đính kèm

  • Quan ly kho Al_Tan Thanh_2022.xlsm
    4 MB · Đọc: 11
  • Quan ly kho Al_Tan Thanh_2022.xlsm
    4 MB · Đọc: 5
Lần chỉnh sửa cuối:
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
3 4 5
Trả lời
84
Đọc
2K
ptm0412
ptm0412
Salem999999999
Lọc dữ liệu có điều kiện
2
Trả lời
26
Đọc
661
VetMini
V
P
  • Question
Xin code gán mở theo tài khoản/profie đăng nhập bằng gmail sẵn trên trình duyệt
Trả lời
4
Đọc
199
phantu93
P
V
công thức của nó là gì ạ. mong mọi người giúp
Trả lời
1
Đọc
75
CHAOQUAY
C
son0611excel
  • Question
VBA tra cứu hình theo điều kiện
Trả lời
13
Đọc
307
ongke0711
ongke0711
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom