Bạn tham khảo đoạn code sau:
Sub Nhap_Xuat_Ton()
Dim dic As Object, Data() As Variant, res() As Variant
Dim i As Long, j As Long, k As Long, r As Long, iKey As Long, sKey As String
Dim book As Workbook, shNhap As Worksheet, shXuat As Worksheet, shTon As Worksheet
Set book = ThisWorkbook
Set shNhap = book.Worksheets("Nhap")
Set shXuat = book.Worksheets("Xuat")
Set shTon = book.Worksheets("Ketquamongmuon")
r = shNhap.Cells(shNhap.Rows.Count, "B").End(xlUp).Row
If r < 3 Then
MsgBox "Khong co du lieu nhap", vbCritical + vbQuestion
Exit Sub
End If
dulieu = shNhap.Range("B3:H" & r).Value
r = UBound(dulieu, 1): ReDim res(1 To r, 1 To 8)
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To r
sKey = dulieu(i, 1) & "|" & dulieu(i, 2)
If Not dic.Exists(sKey) Then
k = k + 1
dic.Add sKey, k
res(k, 1) = k
For j = 2 To 8
res(k, j) = dulieu(i, j - 1)
Next j
Else
iKey = dic(sKey)
res(iKey, 8) = res(iKey, 8) + dulieu(i, 7)
End If
Next i
r = shXuat.Cells(shXuat.Rows.Count, "B").End(xlUp).Row
If r < 3 Then GoTo res_
dulieu = shXuat.Range("B3:H" & r).Value
r = UBound(dulieu, 1)
For i = 1 To r
sKey = dulieu(i, 1) & "|" & dulieu(i, 2)
If dic.Exists(sKey) Then
iKey = dic(sKey)
res(iKey, 8) = res(iKey, 8) - dulieu(i, 7)
End If
Next i
res_:
r = shTon.Cells(shTon.Rows.Count, "B").End(xlUp).Row
If r > 4 Then shTon.Range("A5").Resize(r, 8).ClearContents
If k Then shTon.Range("A5").Resize(k, 8) = res
End SubiKey = dic(sKey): tên biến cần phân biệt Key và item
Em cảm ơn anh đã giúp đỡ nhiệt tình! Code chạy đúng với mong muốn của em ạ!
Em cảm ơn anh đã nhiệt tình góp ý. Code bên trên mà anh Hoàng Nhật Phương viết giúp đã chạy đúng với mong muốn em của em từ #1. Nhưng nếu anh rảnh anh có thể viết giúp em theo 2 trường hợp mà anh vừa gợi ý để em học hỏi thêm được không ạ?
Hic.. con cảm ơn bác Hiếu đã góp ý cho con ạ.
Không có nhập mà có xuất thì cũng là chuyện bình thường trong kỳ, nhưng bạn cần có thêm số lượng đầu kỳ nữa thì mới logic.
Sub Nhap_Xuat_Ton()
Dim dic As Object, Data() As Variant, res(1 To 10000, 1 To 8) As Variant
Dim i As Long, j As Long, k As Long, r As Long, sKey As String
Dim book As Workbook, sheet As Worksheet, shTon As Worksheet
Const sNhap As String = "Nhap"
Const sXuat As String = "Xuat"
Set book = ThisWorkbook
Set shTon = book.Worksheets("Ketquamongmuon")
Set dic = CreateObject("Scripting.Dictionary")
For Each sheet In book.Worksheets
If sheet.Name = sNhap Or sheet.Name = sXuat Then
r = sheet.Cells(sheet.Rows.Count, "B").End(xlUp).Row
If r > 3 Then
dulieu = sheet.Range("B3:H" & r).Value
For i = 1 To UBound(dulieu, 1)
sKey = dulieu(i, 1) & "|" & dulieu(i, 2)
If Not dic.Exists(sKey) Then
k = k + 1
dic.Add sKey, k
res(k, 1) = k
For j = 2 To 7
res(k, j) = dulieu(i, j - 1)
Next j
If sheet.Name = sNhap Then
res(k, 8) = dulieu(i, 7)
ElseIf sheet.Name = sXuat Then
res(k, 8) = dulieu(i, 7) * -1
End If
Else
r = dic(sKey)
If sheet.Name = sNhap Then
res(r, 8) = res(r, 8) + dulieu(i, 7)
ElseIf sheet.Name = sXuat Then
If res(r, 8) >= 0 Then
res(r, 8) = res(r, 8) - dulieu(i, 7)
Else
res(r, 8) = res(r, 8) + (dulieu(i, 7) * -1)
End If
End If
End If
Next i
End If
End If
Next sheet
r = shTon.Cells(shTon.Rows.Count, "B").End(xlUp).Row
If r > 4 Then shTon.Range("A5").Resize(r, 8).ClearContents
If k Then shTon.Range("A5").Resize(k, 8) = res
End Sub"Không có nhập mà có xuất thì cũng là chuyện bình thường trong kỳ" với bảng tính của em bây giờ thì chắc chắn có nhập rồi mới có xuất anh ạ.Bài #2 của anh đã giải quyết vấn đề của em rồi. Em cảm ơn anh đã giúp đỡ. Em sẽ nghiên cứu code của anh ở bài #5. Nếu có gì không hiểu em sẽ hỏi thêm mong anh giải thích giúp em.
