Theo dõi nhập - xuất - tồn

[lq177]

Em mong các anh chị trong diễn đàn giúp em, mọi yêu cầu em đã để trong file đính kèm.
Trân trọng cám ơn!

 

[lequangminh]

mình gửi bạn file này tham khảo nhe!

 

[huuthang_bd]

Em mong các anh chị trong diễn đàn giúp em, mọi yêu cầu em đã để trong file đính kèm.
Trân trọng cám ơn!

Tôi phải sửa mẫu lại nên bạn chịu khó xem trong file nhé.

 

[lq177]

Cho em hỏi thêm nhé, dùng VBA được không anh. bít thì chỉ giùm em nhé.

 

[SA_DQ]

Thích thì chìu, hơi tổn hao thời gian đấy nhé!

Cho em hỏi thêm nhé, dùng VBA được không anh. bít thì chỉ giùm em nhé.

Option Explicit
Dim Sh As Worksheet

Sub TonDauKy()
 Dim WF, Rng As Range, sRng As Range, Cls As Range, Sh0 As Worksheet
 Dim Rws As Long, Jj As Long
 Dim Col As Byte:                            Dim Dat As Date
 
 Set Sh = Sheets("Ton"):                     Sheets("NXT").Select
 Set Rng = Sh.Range(Sh.[E1], Sh.[iV1].End(xlToLeft))
 Dat = [C2].Value:                           Set WF = Application.WorksheetFunction
 Set sRng = Rng.Find([C2].Value, , xlFormulas, xlWhole)
1 'Tính Ton Dau Ky:'
 If sRng Is Nothing Then
11 For Jj = 1 To 367
      Set sRng = Rng.Find(Dat - Jj)
      If Not sRng Is Nothing Then
         Dat = Dat - Jj:                     Exit For
      End If
   Next Jj
   If Jj > 366 Then
      MsgBox "Chi Thong Ke Trong Nam", , "Tam Biet":     Exit Sub
   End If
   CopyTon sRng.Column
   For Jj = 1 To 2
      Set Sh0 = Sheets(Switch(Jj = 1, "Nhap", Jj = 2, "Xuat"))
      Sh0.[iA2].Value = ">=" & Format$(Dat)
      Sh0.[ib2].Value = "<=" & Format$([C2].Value - 1)
      Rws = Sh0.[B65500].End(xlUp).Row
      Sh0.[B1].Resize(Rws, 4).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
         Sh0.Range("iA1:iB2"), CopyToRange:=Sh0.[iA4].Resize(, 4), Unique:=False
      For Each Cls In Range("B5:B" & [B65500].End(xlUp).Row)
         With Cls.Offset(, 3)
            If Jj = 1 Then
               .Value = .Value + _
                  WF.SumIf(Sh0.[iA4].CurrentRegion.Offset(, 1), Cls.Value, Sh0.[iD4])
            Else
               .Value = .Value - _
                  WF.SumIf(Sh0.[iA4].CurrentRegion.Offset(, 1), Cls.Value, Sh0.[iD4])
            End If
         End With
      Next Cls
   Next Jj
 Else
12 Col = sRng.Column
   CopyTon Col
 End If
2 'Nhap & Xuat Trong Kì:'
 For Jj = 1 To 2
   Set Sh0 = Sheets(Switch(Jj = 1, "Nhap", Jj = 2, "Xuat"))
   Sh0.[iA2].Value = ">=" & Format$([C2].Value)
   Sh0.[ib2].Value = "<=" & Format$([C3].Value)
   Rws = Sh0.[B65500].End(xlUp).Row
   Sh0.[B1].Resize(Rws, 4).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
      Sh0.Range("iA1:iB2"), CopyToRange:=Sh0.[iA4].Resize(, 4), Unique:=False
   Rws = [B65500].End(xlUp).Row
   [f5].Resize(Rws).Offset(, Jj - 1).ClearContents
   For Each Cls In [B5].Resize(Rws)
      With Cls.Offset(, 3 + Jj)
         .Value = WF.SumIf(Sh0.[iA4].CurrentRegion.Offset(, 1), Cls.Value, Sh0.[iD4])
      End With
   Next Cls
 Next Jj
End Sub

[B]Sub CopyTon(Col As Byte)[/B]
 Dim Rng As Range, Cls As Range, sRng As Range
 
 Set Rng = Sh.Range("B1:B" & Sh.[B65500].End(xlUp).Row)
 For Each Cls In Range("B5:B" & [B65500].End(xlUp).Row)
   Set sRng = Rng.Find(Cls)
   If Not sRng Is Nothing Then
      Cls.Offset(, 3).Value = Sh.Cells(sRng.Row, Col).Value
   End If
 Next Cls
[B]End Sub[/B]

Tổ hợp fím nóng của nó là {CTRL}+{SHIFT}+T