Nhập xuất tồn theo hạn sử dụng

[moihocvba]

Xin chào cả nhà GPE, em muốn tính tồn kho sản phẩm theo date, cụ thể là nhập kho có ghi date, nhưng xuất kho không ghi date, nhưng khi tính tồn kho thì Excel tự hiểu Date nào gần nhất thì xuất trước, và tính tồn kho ạ. Em có mô tả ở hình bên dưới, mong anh chị giúp đỡ em hàm VBA hoặc Hàm Excel cũng được ạ.



- Sản phẩm nhập vào là Có date (Date không sắp xếp theo thứ tự dòng)
- Xuất kho không ghi date mà Excel tự hiểu cái nào date gần nhất xuất đi để trừ vào tồn kho
- Em cần tính cột K tồn kho dựa vào 2 bảng nhập kho và xuất kho ạ!

Em cám ơn rất nhiều ạ!

Bài đã được tự động gộp: 24/10/22

 

[snow25]

Xin chào cả nhà GPE, em muốn tính tồn kho sản phẩm theo date, cụ thể là nhập kho có ghi date, nhưng xuất kho không ghi date, nhưng khi tính tồn kho thì Excel tự hiểu Date nào gần nhất thì xuất trước, và tính tồn kho ạ. Em có mô tả ở hình bên dưới, mong anh chị giúp đỡ em hàm VBA hoặc Hàm Excel cũng được ạ.

View attachment 282419

- Sản phẩm nhập vào là Có date (Date không sắp xếp theo thứ tự dòng)
- Xuất kho không ghi date mà Excel tự hiểu cái nào date gần nhất xuất đi để trừ vào tồn kho
- Em cần tính cột K tồn kho dựa vào 2 bảng nhập kho và xuất kho ạ!

Em cám ơn rất nhiều ạ!

Bài đã được tự động gộp: 24/10/22

Dữ liệu thật đâu.Mà nó có xắp xếp theo ngày từ nhỏ đến lớn ở nhập không hay là hên sui.

 

[moihocvba]

Dữ liệu thật đâu.Mà nó có xắp xếp theo ngày từ nhỏ đến lớn ở nhập không hay là hên sui.

Dạ dữ liệu thật em không gửi được anh, có file dữ liệu demo đính kèm đó ạ. Làm theo dữ liệu demo rồi em tùy biến theo thực tế cũng được a. Vừa làm vừa học hỏi cách.
Theo thực thế thì nhập hên xui, nhưng nếu khó quá thì mỗi lần nhập xong mình sắp xếp tăng dần theo date cũng được ạ.

 

[snow25]

Dạ dữ liệu thật em không gửi được anh, có file dữ liệu demo đính kèm đó ạ. Làm theo dữ liệu demo rồi em tùy biến theo thực tế cũng được a. Vừa làm vừa học hỏi cách.
Theo thực thế thì nhập hên xui, nhưng nếu khó quá thì mỗi lần nhập xong mình sắp xếp tăng dần theo date cũng được ạ.

Thử code này chưa bẫy lỗi gì về bạn nghiên cứu thêm.

Sub laytonkho()
    Dim i As Long, lr As Long, dic As Object, dk As String, arr, kq, b As Long, a As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("sheet1")
        arr = .Range("E3:F8").Value
        For i = 1 To UBound(arr)
            dk = arr(i, 1)
            If Not dic.exists(dk) Then
                dic.Add dk, arr(i, 2)
            Else
                dic.Item(dk) = dic.Item(dk) + arr(i, 2)
            End If
        Next i
        arr = .Range("A3:C6")
        arr = xapxep(arr)
        ReDim kq(1 To UBound(arr), 1 To 3)
        For i = 1 To UBound(arr)
            dk = arr(i, 1)
            If dic.exists(dk) Then
               b = dic.Item(dk)
               If b > 0 And b <= arr(i, 3) Then
                  arr(i, 3) = arr(i, 3) - b
                  b = 0
               ElseIf b > arr(i, 3) Then
                  b = b - arr(i, 3)
                  arr(i, 3) = 0
               End If
               dic.Item(dk) = b
            End If
            If arr(i, 3) > 0 Then
               a = a + 1
               kq(a, 1) = arr(i, 1)
               kq(a, 2) = arr(i, 2)
               kq(a, 3) = arr(i, 3)
            End If
        Next i
       If a Then .Range("I3:K3").Resize(a).Value = kq
    End With
End Sub
Private Function xapxep(arr)
    Dim i As Long, lr As Long, T, j As Long
    For i = 1 To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If CLng(arr(i, 2)) > CLng(arr(j, 2)) Then
               T = Array(arr(i, 1), arr(i, 2), arr(i, 3))
               arr(i, 1) = arr(j, 1)
               arr(i, 2) = arr(j, 2)
               arr(i, 3) = arr(j, 3)
               arr(j, 1) = T(0)
               arr(j, 2) = T(1)
               arr(j, 3) = T(2)
            End If
       Next j
   Next i
   xapxep = arr
End Function