Code cho sheet Nhập Xuất Tồn có điều kiện ngày (1 người xem)

[minhduongct]

Số là sau một thời gian mày mò thì e cũng tạo cho mình 1 file quản lý xuất nhập tồn đơn giản thôi, nhưng do làm bằng công thức mảng thì nó chạy khá chậm vì với một lượng name tạo ra khá nhiều và dài. Cũng đã cặm cụi tìm hiểu các code cho sheet NXT nhưng khi áp dụng vào thì nó cứ chạy lung tung và trở nên hư hại nhiều thứ . Nay e xin rút trích ra và up file lên nhờ sự hướng dẫn của mọi người giúp e tạo ra 2 code cho 2 sheet NXT và NXTtheongay để e học hỏi thêm với ạ.
Ý e ở đây là viết code NXT để khi e nhập vào cell Đến ngày ở sheet NXT. Sau đó, tạo ra một cmd Cập Nhật và khi click vào nút cập nhật thì nó sẽ cập nhật lại tình hình NXT dựa trên điều kiện ngày nhập vào. Và tương tự cho sheet NXTtheongay.
Mong nhận được sự giúp đỡ của mọi người, e thành thật cảm ơn ạ!
Nói thiệt là e cũng bí lắm rồi hihi, chứ bình thường thì e lên e search rồi tải về quậy phá một hồi lâu cũng ra nhưng lần này thì bó tay.

pass mở VBA: minhduong
trước khi up file e quên mở khóa, sorry mọi người vì sự bất tiện này

 

[tongquangtuyen]

Bạn tìm trên diễn đàn bài chia sẻ file nhập xuất tồn của Bác Ba Tê nhe.

 

[minhduongct]

Bạn tìm trên diễn đàn bài chia sẻ file nhập xuất tồn của Bác Ba Tê nhe.

đang có nhưng k hiểu lắm về đoạn code đó nên chỉnh sửa mãi vẫn k được ạ

 

[tongquangtuyen]

Bạn thử thay hàm sum mãng = sumifs xem file có còn nặng hay không

 

[minhduongct]

sumifs thì đặt điều kiện ngày nó k, có thể hướng dẫn mình cụ thể về điều kiện ngày của sumifs k ạ

 

[tongquangtuyen]

TRO NG SHEET NHAPXUATTON,CỘT G7 GÕ N THÌ THAY BẰNG CÔNG THỨC SAU:
'=SUMIFS(PhatSinh!$I$9:$I$10000,PhatSinh!$F$9:$F$10000,C10,PhatSinh!$E$9:$E$10000,$G$7)
CÒN MU ỐN CHỌN TỪ NGÀY ĐẾN NGÀY SẼ SỬ DỤNG HÀM SUMPRODUCT
NHƯNG TEST TRÊN FILE BẠN THÌ NÓ KHÔNG CHẠY KO HIỂU TẠI SAU.TRONG CÔNG TY MÌNH CŨNG SỬ DỤNG HÀM NÀY THÌ OK

 

[tongquangtuyen]

trong sheeNXT theo ngày sử dụng

'=SUMPRODUCT(--(PhatSinh!$F$9:$F$1000=NXTTheoNgay!C10),--(PhatSinh!$C$9:$C$1000>=NXTTheoNgay!$E$5),--(PhatSinh!$C$9:$C$1000<=NXTTheoNgay!$E$6),--(PhatSinh!$E$9:$E$1000=NXTTheoNgay!$E$7),--(PhatSinh!$I$9:$I$1000))

bạn gõ e7=N nhe

 

[minhduongct]

ok mình sẽ thử xem sao

 

[Ba Tê]

đang có nhưng k hiểu lắm về đoạn code đó nên chỉnh sửa mãi vẫn k được ạ

Code cho sheet NhapXuatTon

Public Sub NXT_1()
Dim Dic As Object, sArr(), dArr(), tArr(), I As Long, J As Long, K As Long, Ngay As Long, Rws As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("DanhMucHH")
    sArr = .Range("B9", .Range("B9").End(xlDown)).Resize(, 7).Value
End With
ReDim dArr(1 To UBound(sArr), 1 To 11)
For I = 1 To UBound(sArr)
    Tem = sArr(I, 1)
    If Not Dic.Exists(Tem) Then
        K = K + 1
        Dic.Item(Tem) = K
        dArr(K, 1) = sArr(I, 2): dArr(K, 2) = sArr(I, 1)
        dArr(K, 3) = sArr(I, 3): dArr(K, 4) = sArr(I, 4): dArr(K, 5) = sArr(I, 6)
    End If
Next I
With Sheets("PhatSinh")
    sArr = .Range("B9", .Range("B9").End(xlDown)).Resize(, 10).Value
End With
With Sheets("NhapXuatTon")
    Ngay = .Range("E6").Value
    For I = 1 To UBound(sArr)
        If sArr(I, 2) <= Ngay Then
            Tem = sArr(I, 5)
            If Dic.Exists(Tem) Then
                Rws = Dic.Item(Tem)
                If sArr(I, 4) = "N" Then
                    dArr(Rws, 6) = dArr(Rws, 6) + sArr(I, 8)
                    dArr(Rws, 7) = dArr(Rws, 7) + sArr(I, 10)
                Else
                    dArr(Rws, 8) = dArr(Rws, 8) + sArr(I, 8)
                    dArr(Rws, 9) = dArr(Rws, 9) + sArr(I, 10)
                End If
            End If
        End If
    Next I
    For I = 1 To K
        dArr(I, 10) = dArr(I, 4) + dArr(I, 6) - dArr(I, 8)
        dArr(I, 11) = dArr(I, 5) + dArr(I, 7) - dArr(I, 9)
    Next I
    .Range("B10").Resize(1000, 11).ClearContents
    .Range("B10").Resize(K, 11) = dArr
End With
Set Dic = Nothing
End Sub

Code cho sheet NXTTheoNgay:

Public Sub NXT_2()
Dim Dic As Object, sArr(), dArr(), tArr(), Tem As String
Dim I As Long, J As Long, K As Long, NgayDau As Long, NgayCuoi As Long, Rws As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("DanhMucHH")
    sArr = .Range("B9", .Range("B9").End(xlDown)).Resize(, 7).Value
End With
ReDim dArr(1 To UBound(sArr), 1 To 7)
For I = 1 To UBound(sArr)
    Tem = sArr(I, 1)
    If Not Dic.Exists(Tem) Then
        K = K + 1
        Dic.Item(Tem) = K
        dArr(K, 1) = sArr(I, 2): dArr(K, 2) = sArr(I, 1): dArr(K, 3) = sArr(I, 3)
    End If
Next I
With Sheets("PhatSinh")
    sArr = .Range("B9", .Range("B9").End(xlDown)).Resize(, 10).Value
End With
With Sheets("NXTTheoNgay")
    NgayDau = .Range("E5").Value
    NgayCuoi = .Range("E6").Value
    For I = 1 To UBound(sArr)
        If sArr(I, 2) >= NgayDau Then
        If sArr(I, 2) <= NgayCuoi Then
            Tem = sArr(I, 5)
            If Dic.Exists(Tem) Then
                Rws = Dic.Item(Tem)
                If sArr(I, 4) = "N" Then
                    dArr(Rws, 4) = dArr(Rws, 4) + sArr(I, 8)
                    dArr(Rws, 5) = dArr(Rws, 5) + sArr(I, 10)
                Else
                    dArr(Rws, 6) = dArr(Rws, 6) + sArr(I, 8)
                    dArr(Rws, 7) = dArr(Rws, 7) + sArr(I, 10)
                End If
            End If
        End If
        End If
    Next I
    .Range("B10").Resize(1000, 7).ClearContents
    .Range("B10").Resize(K, 7) = dArr
End With
Set Dic = Nothing
End Sub

 

[minhduongct]

e cảm ơn rất nhiều ạ, đây là cái mà e cần bao lâu nay ạ

 

[minhduongct]

cái này dữ liệu có tăng lên mấy chục ngàn dòng thì nó vẫn chạy bình thường đúng k thầy