Hôm trước đã giới thiệu với các bạn cách tính tồn kho hoàn toàn theo query. Hôm nay trong topic này xin giới thiệu với các bạn cách tính tồn kho bằng hàm VBA vì viết bằng VBA tính bảo mật sẽ cao hơn
(Bài cũ http://thuthuataccess.com/forum/thread-4930.html)
Vẫn lấy CSDL của bài trước, các bạn tạo thêm một table tblTonKho gồm các trường
MaHang Text 20 PrimaryKey
TonDau Number Double Standar 0
Nhap Number Double Standar 0
Xuat Number Double Standar 0
TonCuoi Number Double Standar 0

Hàm Tính Tồn Kho được viết trong modul như sau


P/S : Hàm này tính tồn kho theo Tháng/Năm. Các bạn chế biến theo yêu cầu ví dụ tính tồn kho từ ngày đến ngày....
Đây là một cách viết cơ bản nhất, nó ...hơi dài dòng nhưng dễ hiểu và dễ tiếp cận với những ai mới chập chững đến với VBA. Những ai đã tiếp cận và hơi vững về VBA thì có thể xào nấu lại cho ngắn gọn hơn
Thân mến

bạn Xuân Thanh có thể up file demo cho mình tham khảo trực tiếp được không ?

Bạn theo đường link này http://thuthuataccess.com/forum/thread-4930.html , tạo CSDL như hướng dẫn, nhập liệu vào table rồi thực hiện lệnh chạy hàm là OK mà

Bạn nào biết Union thì có thể viết lại hàm trên như sau

Thân mến

Bài viết rất hay, mà bạn có thể giải thích dùm mình 1 chổ đươc không? (xem mãi mà chẳng hiểu, do không rành về code cho lắm)
Tại sao mỗi khi mình seek xong thì dùng lệnh Bookmark = cái LastModified
Vì sao phải dùng? tác dụng của nó như thế nào? nếu không dùng thì có được không?
Nhờ bạn giải thích dùm nhé! thanksnhiueefu

(25-06-13, 02:28 PM)Xuân Thanh Đã viết: Bạn nào biết Union thì có thể viết lại hàm trên như sau

Mã PHP:

Function TonKho(Thang As Integer, Nam As Integer)

' Dinh nghia và set bien    
   Dim StartDate As Date, StopDate As Date
   StartDate = DateSerial(Nam, Thang, 1)
   StopDate = DateSerial(Nam, Thang + 1, 1) - 1
   Dim rsTon As Recordset
   Set rsTon = CurrentDb.OpenRecordset("tblTonKho", dbOpenTable)
   If rsTon.RecordCount > 0 Then
       DoCmd.SetWarnings False
       DoCmd.RunSQL "Delete * From tblTonKho"
       DoCmd.SetWarnings True
   End If
   rsTon.Index = "PrimaryKey"
   Dim rsNX As Recordset
   Set rsNX = CurrentDb.OpenRecordset("Select a.NgayLap, b.MaHang, b.SoLuong As SLNhap, 0 As SLXuat" & _
       " From tblPhieuNhap As a Inner join tblPhieuNhapChiTiet as b on a.MaPhieuNhap = b.MaPhieuNhap" & _
       " Union Select c.NgayLap, d.MaHang, 0 As SLNhap, d.SoLuong As SLXuat" & _
       " From tblPhieuXuat As c Inner join tblPhieuXuatChiTiet as d on c.MaPhieuXuat = d.MaPhieuXuat")
   
' Tinh Ton Dau
   If rsNX.RecordCount > 0 Then
       rsNX.MoveFirst
       Do Until rsNX.EOF
           If rsNX!NgayLap >= StartDate Then Exit Do
           If rsNX!NgayLap < StartDate Then
               rsTon.Seek "=", rsNX!MaHang
               If rsTon.NoMatch Then
                   rsTon.AddNew
                   rsTon!MaHang = rsNX!MaHang
                   rsTon.Update
                   rsTon.Bookmark = rsTon.LastModified
               End If
               rsTon.Edit
               rsTon!TonDau = rsTon!TonDau + rsNX!SLNhap - rsNX!SLXuat                
               rsTon.Update
           End If
           rsNX.MoveNext
       Loop
   End If
   
' Tinh Nhap Xuat Trong Thang
   If rsNX.RecordCount > 0 Then
       rsNX.MoveFirst
       Do Until rsNX.EOF
           If rsNX!NgayLap > StopDate Then Exit Do
           If rsNX!NgayLap >= StartDate Then
               rsTon.Seek "=", rsNX!MaHang
               If rsTon.NoMatch Then
                   rsTon.AddNew
                   rsTon!MaHang = rsNX!MaHang
                   rsTon.Update
                   rsTon.Bookmark = rsTon.LastModified
               End If
               rsTon.Edit
               rsTon!Nhap = rsTon!Nhap + rsNX!SLNhap                
               rsTon!Xuat = rsTon!Xuat + rsNX!SLXuat                
               rsTon.Update
           End If
           rsNX.MoveNext
       Loop
   End If
   
' Tinh Ton Cuoi Thang
   rsTon.MoveFirst
   Do Until rsTon.EOF
       rsTon.Edit
       rsTon!TonCuoi = rsTon!TonDau + rsTon!Nhap - rsTon!Xuat        
       rsTon.Update
       rsTon.MoveNext
   Loop
   rsNX.Close: rsTon.Close
End Function 


Thân mến

(25-06-13, 02:28 PM)Xuân Thanh Đã viết: Bạn nào biết Union thì có thể viết lại hàm trên như sau

Mã PHP:

Function TonKho(Thang As Integer, Nam As Integer)

' Dinh nghia và set bien    
   Dim StartDate As Date, StopDate As Date
   StartDate = DateSerial(Nam, Thang, 1)
   StopDate = DateSerial(Nam, Thang + 1, 1) - 1
   Dim rsTon As Recordset
   Set rsTon = CurrentDb.OpenRecordset("tblTonKho", dbOpenTable)
   If rsTon.RecordCount > 0 Then
       DoCmd.SetWarnings False
       DoCmd.RunSQL "Delete * From tblTonKho"
       DoCmd.SetWarnings True
   End If
   rsTon.Index = "PrimaryKey"
   Dim rsNX As Recordset
   Set rsNX = CurrentDb.OpenRecordset("Select a.NgayLap, b.MaHang, b.SoLuong As SLNhap, 0 As SLXuat" & _
       " From tblPhieuNhap As a Inner join tblPhieuNhapChiTiet as b on a.MaPhieuNhap = b.MaPhieuNhap" & _
       " Union Select c.NgayLap, d.MaHang, 0 As SLNhap, d.SoLuong As SLXuat" & _
       " From tblPhieuXuat As c Inner join tblPhieuXuatChiTiet as d on c.MaPhieuXuat = d.MaPhieuXuat")
   
' Tinh Ton Dau
   If rsNX.RecordCount > 0 Then
       rsNX.MoveFirst
       Do Until rsNX.EOF
           If rsNX!NgayLap >= StartDate Then Exit Do
           If rsNX!NgayLap < StartDate Then
               rsTon.Seek "=", rsNX!MaHang
               If rsTon.NoMatch Then
                   rsTon.AddNew
                   rsTon!MaHang = rsNX!MaHang
                   rsTon.Update
                   rsTon.Bookmark = rsTon.LastModified
               End If
               rsTon.Edit
               rsTon!TonDau = rsTon!TonDau + rsNX!SLNhap - rsNX!SLXuat                
               rsTon.Update
           End If
           rsNX.MoveNext
       Loop
   End If
   
' Tinh Nhap Xuat Trong Thang
   If rsNX.RecordCount > 0 Then
       rsNX.MoveFirst
       Do Until rsNX.EOF
           If rsNX!NgayLap > StopDate Then Exit Do
           If rsNX!NgayLap >= StartDate Then
               rsTon.Seek "=", rsNX!MaHang
               If rsTon.NoMatch Then
                   rsTon.AddNew
                   rsTon!MaHang = rsNX!MaHang
                   rsTon.Update
                   rsTon.Bookmark = rsTon.LastModified
               End If
               rsTon.Edit
               rsTon!Nhap = rsTon!Nhap + rsNX!SLNhap                
               rsTon!Xuat = rsTon!Xuat + rsNX!SLXuat                
               rsTon.Update
           End If
           rsNX.MoveNext
       Loop
   End If
   
' Tinh Ton Cuoi Thang
   rsTon.MoveFirst
   Do Until rsTon.EOF
       rsTon.Edit
       rsTon!TonCuoi = rsTon!TonDau + rsTon!Nhap - rsTon!Xuat        
       rsTon.Update
       rsTon.MoveNext
   Loop
   rsNX.Close: rsTon.Close
End Function 


Thân mến

Chào mọi người

Mình có làm demo như gợi ý của tác giả Xuân Thanh cả cách tính bằng VBA và bằng query nhưng kết quả không giống nhau. Mọi người xem giúp
Xin cảm ơn
link demo http://www.mediafire.com/file/e6m33a9zg3...TONKHO.mdb

(06-10-17, 03:59 PM)bnvhai Đã viết: Mình có làm demo như gợi ý của tác giả Xuân Thanh cả cách tính bằng VBA và bằng query nhưng kết quả không giống nhau. Mọi người xem giúp
Xin cảm ơn
link demo http://www.mediafire.com/file/e6m33a9zg3...TONKHO.mdb

Cả 2 cách tính bằng Query hay VBA của bác Xuân Thanh đều sai ở 1 điểm quan trọng dẫn đến kết quả tính tồn kho sai đó là cái Union Query Nhập Xuất. Phải dùng UNION ALL chứ không dùng UNION như hiện tại. Vì nếu dùng UNION không thôi sẽ bi thiếu dữ liệu nếu có phát sinh Nhập - Xuất cùng 1 MAHANG, cùng 1 ngày (Union nó sẽ loại bỏ dòng trùng). Do vậy bạn cần phải sửa 2 chỗ:
- Q_NhapXuat: Đổi từ Union —> Union All.
- Hàm TINHTONKHO: Cũng đổi thành Union All trong câu lệnh SQL của rsNX. Riêng trong câu lệnh Union SQL sau khi đổi thành Union All cần phải sắp xếp records theo cột NgayLap giảm dần để tránh sai khi chạy vòng lặp ở các câu lệnh sau đó.

Sau đây là hàm tính Tồn kho tôi đã sửa lại và sẳn đổi luôn qua dùng DAO để có thể sử dụng được cho Linked Table luôn.

Mã PHP:

Option Compare Database
[/font]
Option Explicit

'XUAN THANH THUTHUATACCESS.COM'
Function TINHTONKHO(Ngaydau As Date, Ngaycuoi As Date)

   Dim db As DAO.Database
   Dim rsNX As DAO.Recordset
   Dim rsTon As DAO.Recordset

   Set db = CurrentDb
   Set rsNX = db.OpenRecordset("SELECT a.NgayLap,b.MaHang,b.soluong as SLNhap, 0 as SLXuat " & _
                               "FROM tblHANGNHAP As a INNER JOIN tblHANGNHAPCHITIET As b on a.MaSoNhap=b.MaSoNhap " & _
                               "UNION ALL SELECT c.NgayLap,d.MaHang,0 as SLNhap,d.soluong as SLXuat " & _
                               "FROM tblHANGXUAT As c INNER JOIN tblHANGXUATCHITIET As d on c.MaSoXuat=d.MasoXuat " & _
                               "ORDER BY NgayLap", dbOpenSnapshot)

   
   db.Execute "DELETE * FROM tblTONKHO", dbFailOnError
   Set rsTon = db.OpenRecordset("tblTONKHO", dbOpenDynaset)
   
   ' TINH TON DAU KY'

   If rsNX.RecordCount > 0 Then
       rsNX.MoveFirst
       Do Until rsNX.EOF
           If rsNX!NGAYLAP >= Ngaydau Then Exit Do
           If rsNX!NGAYLAP < Ngaydau Then
               rsTon.FindFirst "[MAHANG] ='" & rsNX!MAHANG & "'"
               If rsTon.NoMatch Then
                   rsTon.AddNew
                   rsTon!MAHANG = rsNX!MAHANG
                   rsTon.Update
                   rsTon.Bookmark = rsTon.LastModified
               End If

               rsTon.Edit
               rsTon!tondau = Nz(rsTon!tondau) + Nz(rsNX!SLNhap) - Nz(rsNX!SLXuat)
               rsTon.Update

           End If

           rsNX.MoveNext

       Loop
   End If


   'TINH NHAP XUAT TRONG KY'

   If rsNX.RecordCount > 0 Then
       rsNX.MoveFirst
       Do Until rsNX.EOF
           If rsNX!NGAYLAP > Ngaycuoi Then Exit Do
           If Ngaycuoi >= rsNX!NGAYLAP And rsNX!NGAYLAP >= Ngaydau Then
               rsTon.FindFirst "[MAHANG] ='" & rsNX!MAHANG & "'"
               If rsTon.NoMatch Then
                   rsTon.AddNew
                   rsTon!MAHANG = rsNX!MAHANG
                   rsTon.Update
                   rsTon.Bookmark = rsTon.LastModified
               End If

               rsTon.Edit
               rsTon!nhap = rsTon!nhap + rsNX!SLNhap
               rsTon!xuat = rsTon!xuat + rsNX!SLXuat
               rsTon.Update

           End If

           rsNX.MoveNext

       Loop

   End If

   ' TINH TON CUOI'
   If rsTon.RecordCount <> 0 Then
       rsTon.MoveFirst
   End If

   Do Until rsTon.EOF
       rsTon.Edit
       rsTon!toncuoi = rsTon!tondau + rsTon!nhap - rsTon!xuat
       rsTon.Update
       rsTon.MoveNext

   Loop

   rsTon.Close
   rsNX.Close
   Set rsTon = Nothing
   Set rsNX = Nothing
   db.Close

End Function
[font=Tahoma] 


Hôm nay mới đọc lại bài này. Cám ơn ongke 0711 đã phát hiện ra cái sót. Đúng là phải ghi thêm chữ ALL sau mệnh đề UNION. Do viết vội nên sót