Lập báo cáo theo dõi nhập - xuất - tồn theo tháng bằng VBA

[biboylenka1]

Em xin chào anh/chị.
Hiện tại em đang có một file excel theo dõi nhập xuất tồn kho.
Trong sheet "BaoCaoNXT2" em đang sử dụng công thức để theo dõi nhập - xuất - tồn theo từng ngày trong tháng, bây giờ em muốn chuyển sang sử dụng VBA.
Em nhờ anh/chị trong diễn đàn chuyển giúp em sang code VBA với ạ.
Em xin cảm ơn anh/chị.

 

[HieuCD]

Em xin chào anh/chị.
Hiện tại em đang có một file excel theo dõi nhập xuất tồn kho.
Trong sheet "BaoCaoNXT2" em đang sử dụng công thức để theo dõi nhập - xuất - tồn theo từng ngày trong tháng, bây giờ em muốn chuyển sang sử dụng VBA.
Em nhờ anh/chị trong diễn đàn chuyển giúp em sang code VBA với ạ.
Em xin cảm ơn anh/chị.

Chạy code

Option Explicit
Sub NXT2()
  Dim eRow&, sRow&, i&, j&, k&, ik&
  Dim aNhap(), aXuat(), res(), Dic As Object, iKey$
  Dim fDay, eDay

  sRow = Sheets("DanhMuc").Range("B" & Rows.count).End(xlUp).Row - 3
  ReDim res(1 To sRow, 1 To 69)
  With Sheets("NhapKho")
    eRow = .Range("B" & Rows.count).End(xlUp).Row
    If eRow >= 3 Then aNhap = .Range("B3:K" & eRow).Value
  End With
  With Sheets("XuatKho")
    i = .Range("B" & Rows.count).End(xlUp).Row
    If eRow < 3 And i < 3 Then MsgBox "Khong co du lieu nhap xuat", , "Thong Bao"
    aXuat = .Range("B3:K" & i).Value
  End With
  With Sheets("BaoCaoNXT2")
    fDay = .Range("F6").Value
    eDay = .Range("F7").Value
    If fDay = Empty Or eDay = Empty Or fDay > eDay Or IsDate(fDay) = False Or IsDate(eDay) = False Then
      MsgBox "Chua nhap du thong tin ngay thang", , "Thong Bao"
      Exit Sub
    End If
  End With
  Set Dic = CreateObject("Scripting.Dictionary")
  sRow = UBound(aNhap)
  For i = 1 To sRow
    iKey = aNhap(i, 6)
    If Not Dic.Exists(iKey) Then
      k = k + 1
      Dic.Add iKey, k
      res(k, 1) = k
      For j = 2 To 5
        res(k, j) = aNhap(i, j + 4)
      Next j
    End If
    ik = Dic.Item(iKey)
    If aNhap(i, 3) = "NKDK" Or aNhap(i, 1) < fDay Then
      res(ik, 6) = res(ik, 6) + aNhap(i, 10)
      res(ik, 69) = res(ik, 69) + aNhap(i, 10)
    ElseIf aNhap(i, 1) <= eDay Then
      j = 2 * (aNhap(i, 1) - fDay) + 7
      res(ik, j) = res(ik, j) + aNhap(i, 10)
      res(ik, 69) = res(ik, 69) + aNhap(i, 10)
    End If
  Next i
 
  sRow = UBound(aXuat)
  For i = 1 To sRow
    iKey = aXuat(i, 6)
    If Not Dic.Exists(iKey) Then
      k = k + 1
      Dic.Add iKey, k
      res(k, 1) = k
      For j = 2 To 5
        res(k, j) = aXuat(i, j + 4)
      Next j
    End If
    ik = Dic.Item(iKey)
    If aXuat(i, 1) < fDay Then
      res(ik, 6) = res(ik, 6) - aXuat(i, 10)
      res(ik, 69) = res(ik, 69) - aXuat(i, 10)
    ElseIf aXuat(i, 1) <= eDay Then
      j = 2 * (aXuat(i, 1) - fDay) + 8
      res(ik, j) = res(ik, j) + aXuat(i, 10)
      res(ik, 69) = res(ik, 69) - aXuat(i, 10)
    End If
  Next i
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  With Sheets("BaoCaoNXT2")
    On Error Resume Next
    .ShowAllData
    On Error GoTo 0
    .Range("B12:B1000").EntireRow.Hidden = False
    .Range("B13:BR1000").ClearContents
    If k > 0 Then .Range("B13").Resize(k, 69) = res
  End With
  MsgBox "Xong", , "Thong Bao"
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
End Sub

 

[biboylenka1]

Chạy code

Em cảm ơn anh, code chạy đúng với mong muốn của em rồi ạ.
Hai đoạn này

j = 2 * (aNhap(i, 1) - fDay) + 7

j = 2 * (aXuat(i, 1) - fDay) + 8

Hay quá anh. em loay hoay mãi mà không biết viết như thế nào. Em mới biết xem code của các anh/chị trên diễn đàn rồi bắt chước theo chứ không nghĩ ra được như thế này.