Nhờ giúp sửa code nhập xuất tồn và tính hạn sử dụng

[saobekhonglac]

Chào anh/chị.

Em có gửi file NXT và thầy BaTe có làm giúp em 1 code nhưng khi mang qua áp dụng với file thực tế thì code bị lỗi, nhờ anh/chị xem và giữa lỗi giúp em với..
Tại sheet NXT em có số tồn kho tại cột H. Trong 1 tháng có thể nhập kho nhiều lần và nguyên tắc xuất hàng là xuất những mặt hàng nhập kho trước, Em có làm tay thử MSP ở dòng 8, nhờ anh/chị xem giúp em.

Cám ơn và chúc 1 ngày cuối tuần vui vẻ.

 

[chucuoi92]

Chào anh/chị.

Em có gửi file NXT và thầy BaTe có làm giúp em 1 code nhưng khi mang qua áp dụng với file thực tế thì code bị lỗi, nhờ anh/chị xem và giữa lỗi giúp em với..
Tại sheet NXT em có số tồn kho tại cột H. Trong 1 tháng có thể nhập kho nhiều lần và nguyên tắc xuất hàng là xuất những mặt hàng nhập kho trước, Em có làm tay thử MSP ở dòng 8, nhờ anh/chị xem giúp em.

Cám ơn và chúc 1 ngày cuối tuần vui vẻ.

Bạn chép code này vào xem nhé!
Những chỗ màu xanh là sửa.

Public Sub GPE_NXT()
Dim Dic As Object, sArr(), dArr(), I As Long, K As Long, Xuat As Long, Rws As Long, Col As Long, MaxCol As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("NXT")
sArr = .Range("B7", .Range("B7").End(xlDown)).Resize(, 6).Value
End With
ReDim dArr(1 To UBound(sArr), 1 To 100)
For I = 2 To UBound(sArr)
K = K + 1
Dic.Item(sArr(I, 1)) = K
dArr(K, 99) = -1
dArr(K, 100) = sArr(I, 6)
Next I
With Sheets("Nhap")
sArr = .Range("E12", .Range("E12").End(xlDown)).Resize(, 8).Value
End With
For I = 1 To UBound(sArr)
If Dic.Exists(sArr(I, 1)) Then
Rws = Dic.Item(sArr(I, 1))
If sArr(I, 4) > dArr(Rws, 100) Then
Col = dArr(Rws, 99) + 2
dArr(Rws, 99) = Col
dArr(Rws, Col) = sArr(I, 4) - dArr(Rws, 100)
dArr(Rws, 100) = 0
dArr(Rws, Col + 1) = sArr(I, 8)
'dArr(Rws, 100) = dArr(Rws, Col)
If Col > MaxCol Then MaxCol = Col
Else
dArr(Rws, 100) = dArr(Rws, 100) - sArr(I, 4)
End If
End If
Next I
With Sheets("NXT")
.Range("I8").Resize(1000, 100).ClearContents
.Range("I8").Resize(K, MaxCol + 1) = dArr
End With
Set Dic = Nothing
End Sub

 

[saobekhonglac]

Bữa mình cũng có sửa nhưng những số 4,8 mình chẳng biết sửa ntn nên nó không ra.

Cám ơn bạn

Bạn chép code này vào xem nhé!
Những chỗ màu xanh là sửa.

Public Sub GPE_NXT()
Dim Dic As Object, sArr(), dArr(), I As Long, K As Long, Xuat As Long, Rws As Long, Col As Long, MaxCol As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("NXT")
sArr = .Range("B7", .Range("B7").End(xlDown)).Resize(, 6).Value
End With
ReDim dArr(1 To UBound(sArr), 1 To 100)
For I = 2 To UBound(sArr)
K = K + 1
Dic.Item(sArr(I, 1)) = K
dArr(K, 99) = -1
dArr(K, 100) = sArr(I, 6)
Next I
With Sheets("Nhap")
sArr = .Range("E12", .Range("E12").End(xlDown)).Resize(, 8).Value
End With
For I = 1 To UBound(sArr)
If Dic.Exists(sArr(I, 1)) Then
Rws = Dic.Item(sArr(I, 1))
If sArr(I, 4) > dArr(Rws, 100) Then
Col = dArr(Rws, 99) + 2
dArr(Rws, 99) = Col
dArr(Rws, Col) = sArr(I, 4) - dArr(Rws, 100)
dArr(Rws, 100) = 0
dArr(Rws, Col + 1) = sArr(I, 8)
'dArr(Rws, 100) = dArr(Rws, Col)
If Col > MaxCol Then MaxCol = Col
Else
dArr(Rws, 100) = dArr(Rws, 100) - sArr(I, 4)
End If
End If
Next I
With Sheets("NXT")
.Range("I8").Resize(1000, 100).ClearContents
.Range("I8").Resize(K, MaxCol + 1) = dArr
End With
Set Dic = Nothing
End Sub