CÔNG THỨC TỒN NHẬP XUẤT TỪ NGÀY ĐẾN NGÀY

[thanhtan19]

Gửi anh chị
Em có file NXT kho
nhưng nhập xuất tồn từ ngày đến ngày em không viết được
Mong anh chị giúp đỡ em VBA tổng hợp XNT trong sheet XNT được không ạ
em cám ơn anh chị

 

[HieuCD]

Gửi anh chị
Em có file NXT kho
nhưng nhập xuất tồn từ ngày đến ngày em không viết được
Mong anh chị giúp đỡ em VBA tổng hợp XNT trong sheet XNT được không ạ
em cám ơn anh chị

Chay code

Option Explicit

Sub XYZ()
  Dim aDM(), aPS(), Res(), Dic As Object, ikey$
  Dim sRow&, i&, j&, k&, iR&, fDate, eDate

  Set Dic = CreateObject("Scripting.Dictionary")
  With Sheets("N-X-T")
    fDate = .Range("A6").Value: eDate = .Range("A7").Value
  End With
  If fDate = Empty Then fDate = DateValue("1930/1/1")
  If eDate = Empty Then eDate = DateValue("2100/31/1")
  If TypeName(fDate) <> "Date" Or TypeName(eDate) <> "Date" Then
    MsgBox ("ô A6 hoac A7 Nhap Sai Dang Ngay Thang!"): Exit Sub
  End If
  If fDate > eDate Then
    MsgBox "Tu Ngày phai <= Den Ngày!": Exit Sub
  End If
 
  With Sheets("Danhmuc")
    aDM = .Range("B9:E" & .Range("B" & Rows.Count).End(xlUp).Row).Value
  End With
  With Sheets("Nhaplieu")
    aPS = .Range("A11:H" & .Range("A" & Rows.Count).End(xlUp).Row).Value
  End With
 
  sRow = UBound(aDM)
  ReDim Res(1 To sRow + UBound(aPS), 1 To 7)
  For i = 1 To sRow
    ikey = aDM(i, 1)
    If Not Dic.exists(ikey) Then
      k = k + 1
      Dic.Add ikey, k
      Res(k, 1) = ikey: Res(k, 2) = aDM(i, 2): Res(k, 3) = aDM(i, 3)
    End If
    If aDM(i, 4) > 0 Then
      iR = Dic.Item(ikey)
      Res(iR, 4) = Res(iR, 4) + aDM(i, 4)
    End If
  Next i
 
  sRow = UBound(aPS)
  For i = 1 To sRow
    If aPS(i, 1) <= eDate Then
      ikey = aPS(i, 4)
      If Not Dic.exists(ikey) Then
        k = k + 1
        Dic.Add ikey, k
        Res(k, 1) = ikey: Res(k, 2) = aPS(i, 5): Res(k, 3) = aPS(i, 6)
      End If
      iR = Dic.Item(ikey)
      If aPS(i, 1) < fDate Then
        Res(iR, 4) = Res(iR, 4) + aPS(i, 7) - aPS(i, 8)
      Else
        If aPS(i, 8) = Empty Then
          Res(iR, 5) = Res(iR, 5) + aPS(i, 7)
        Else
          Res(iR, 6) = Res(iR, 6) + aPS(i, 8)
        End If
      End If
    End If
  Next i
 
  iR = 0
  For i = 1 To k
    For j = 4 To 6
      If Res(i, j) > 0 Then Exit For
    Next j
    If j <= 6 Then 'Loai bo cac dong khong Ton, Nhap va Xuat
      iR = iR + 1
      For j = 1 To 6
        Res(iR, j) = Res(i, j)
      Next j
      Res(iR, 7) = Res(iR, 4) + Res(iR, 5) - Res(iR, 6)
    End If
  Next i
 
  Application.ScreenUpdating = False
  With Sheets("N-X-T")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 10 Then Range("A11:G" & i).Clear
    If iR > 0 Then
      .Range("A11").Resize(iR).NumberFormat = "@"
      .Range("A11").Resize(iR, 7).Value = Res
      .Range("A11").Resize(iR, 7).Borders.LineStyle = 1
      .Range("A11").Resize(iR, 7).Sort .Range("A11"), 1
    End If
  End With
  Application.ScreenUpdating = True
End Sub

 

[Hoangquyenbong]

Chay code

Option Explicit

Sub XYZ()
  Dim aDM(), aPS(), Res(), Dic As Object, ikey$
  Dim sRow&, i&, j&, k&, iR&, fDate, eDate

  Set Dic = CreateObject("Scripting.Dictionary")
  With Sheets("N-X-T")
    fDate = .Range("A6").Value: eDate = .Range("A7").Value
  End With
  If fDate = Empty Then fDate = DateValue("1930/1/1")
  If eDate = Empty Then eDate = DateValue("2100/31/1")
  If TypeName(fDate) <> "Date" Or TypeName(eDate) <> "Date" Then
    MsgBox ("ô A6 hoac A7 Nhap Sai Dang Ngay Thang!"): Exit Sub
  End If
  If fDate > eDate Then
    MsgBox "Tu Ngày phai <= Den Ngày!": Exit Sub
  End If

  With Sheets("Danhmuc")
    aDM = .Range("B9:E" & .Range("B" & Rows.Count).End(xlUp).Row).Value
  End With
  With Sheets("Nhaplieu")
    aPS = .Range("A11:H" & .Range("A" & Rows.Count).End(xlUp).Row).Value
  End With

  sRow = UBound(aDM)
  ReDim Res(1 To sRow + UBound(aPS), 1 To 7)
  For i = 1 To sRow
    ikey = aDM(i, 1)
    If Not Dic.exists(ikey) Then
      k = k + 1
      Dic.Add ikey, k
      Res(k, 1) = ikey: Res(k, 2) = aDM(i, 2): Res(k, 3) = aDM(i, 3)
    End If
    If aDM(i, 4) > 0 Then
      iR = Dic.Item(ikey)
      Res(iR, 4) = Res(iR, 4) + aDM(i, 4)
    End If
  Next i

  sRow = UBound(aPS)
  For i = 1 To sRow
    If aPS(i, 1) <= eDate Then
      ikey = aPS(i, 4)
      If Not Dic.exists(ikey) Then
        k = k + 1
        Dic.Add ikey, k
        Res(k, 1) = ikey: Res(k, 2) = aPS(i, 5): Res(k, 3) = aPS(i, 6)
      End If
      iR = Dic.Item(ikey)
      If aPS(i, 1) < fDate Then
        Res(iR, 4) = Res(iR, 4) + aPS(i, 7) - aPS(i, 8)
      Else
        If aPS(i, 8) = Empty Then
          Res(iR, 5) = Res(iR, 5) + aPS(i, 7)
        Else
          Res(iR, 6) = Res(iR, 6) + aPS(i, 8)
        End If
      End If
    End If
  Next i

  iR = 0
  For i = 1 To k
    For j = 4 To 6
      If Res(i, j) > 0 Then Exit For
    Next j
    If j <= 6 Then 'Loai bo cac dong khong Ton, Nhap va Xuat
      iR = iR + 1
      For j = 1 To 6
        Res(iR, j) = Res(i, j)
      Next j
      Res(iR, 7) = Res(iR, 4) + Res(iR, 5) - Res(iR, 6)
    End If
  Next i

  Application.ScreenUpdating = False
  With Sheets("N-X-T")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 10 Then Range("A11:G" & i).Clear
    If iR > 0 Then
      .Range("A11").Resize(iR).NumberFormat = "@"
      .Range("A11").Resize(iR, 7).Value = Res
      .Range("A11").Resize(iR, 7).Borders.LineStyle = 1
      .Range("A11").Resize(iR, 7).Sort .Range("A11"), 1
    End If
  End With
  Application.ScreenUpdating = True
End Sub

Dạ em xin phép được xin file hoàn chỉnh của chủ bài và của bác #HieuCD được không ạ. em cũng dán code vào để chạy thử mà không thấy nó chạy từ ngày đến ngày như mình chọn ạ. Em cảm ơn nhiều ạ !

 

[HieuCD]

Dạ em xin phép được xin file hoàn chỉnh của chủ bài và của bác #HieuCD được không ạ. em cũng dán code vào để chạy thử mà không thấy nó chạy từ ngày đến ngày như mình chọn ạ. Em cảm ơn nhiều ạ !

Xem file ........

 

[Hoangquyenbong]

Xem file ........

Em cảm ơn bác nhiều ạ !