• Tùy chọn
• Đăng nhập
• Đăng ký
• Xem như trên Máy tính
• Accelerated Mobile Pages Theme

Dùng VBA để tính tồn kho

• Trang chủ

  • Thủ Thuật Access
  • Access Nâng Cao
  • Thư Viện Hàm
  • Dùng VBA để tính tồn kho
• Dùng VBA để tính tồn kho

• Dùng VBA để tính tồn kho

  Xuân Thanh > 22-06-13, 02:20 PM

  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
  
  

  Mã PHP:

  Function TinhTonKho(Thang As Integer, Nam As Integer)

' Dinh nghia va set bien
    Dim NgayDauThang As Date
    Dim NgayCuoiThang As Date
    NgayDauThang = DateSerial(Nam, Thang, 1)
    NgayCuoiThang = DateSerial(Nam, Thang + 1, 1) - 1
    Dim rsNhap As Recordset
    Dim rsXuat As Recordset
    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"
    Set rsNhap = CurrentDb.OpenRecordset("Select a.NgayLap, b.MaHang, b.SoLuong" & _
        " From tblPhieuNhap As a Inner join tblPhieuNhapchiTiet as b on a.MaPhieuNhap = b.maPhieuNhap" & _
        " Order by a.NgayLap")
    Set rsXuat = CurrentDb.OpenRecordset("Select c.NgayLap, d.MaHang, d.SoLuong" & _
        " From tblPhieuXuat As c Inner join tblPhieuXuatchiTiet as d on c.MaPhieuXuat = d.MaPhieuXuat" & _
        " Order by c.NgayLap")
        
' Tinh Ton Dau Ky
    If rsNhap.RecordCount > 0 Then
        rsNhap.MoveFirst
        Do Until rsNhap.EOF
            If rsNhap!NgayLap >= NgayDauThang Then Exit Do
            If rsNhap!Ngaylap < NgayDauThang Then
                rsTon.Seek "=", rsNhap!MaHang
                If rsTon.NoMatch Then
                    rsTon.AddNew
                    rsTon!MaHang = rsNhap!MaHang
                    rsTon.Update
                    rsTon.Bookmark = rsTon.LastModified
                End If
                rsTon.Edit
                rsTon!TonDau = rsTon!TonDau + rsNhap!SoLuong
                rsTon.Update
            End If
            rsNhap.MoveNext
        Loop
    End If
    If rsXuat.RecordCount > 0 Then
        rsXuat.MoveFirst
        Do Until rsXuat.EOF
            If rsXuat!NgayLap >= NgayDauThang Then Exit Do
            If rsXuat!NgayLap < NgayDauThang Then
                rsTon.Seek "=", rsXuat!MaHang
                If rsTon.NoMatch Then
                    rsTon.AddNew
                    rsTon!MaHang = rsXuat!MaHang
                    rsTon.Update
                    rsTon.Bookmark = rsTon.LastModified
                End If
                rsTon.Edit
                rsTon!TonDau = rsTon!TonDau - rsXuat!SoLuong
                rsTon.Update
            End If
            rsXuat.MoveNext
        Loop
    End If
    
' Tinh Nhap Xuat Trong Thang
    If rsNhap.RecordCount > 0 Then
        rsNhap.MoveFirst
        Do Until rsNhap.EOF
            If rsNhap!NgayLap > NgayCuoiThang Then Exit Do
            If rsNhap!NgayLap >= NgayDauThang Then
                rsTon.Seek "=", rsNhap!MaHang
                If rsTon.NoMatch Then
                    rsTon.AddNew
                    rsTon!MaHang = rsNhap!MaHang
                    rsTon.Update
                    rsTon.Bookmark = rsTon.LastModified
                End If
                rsTon.Edit
                rsTon!Nhap = rsTon!Nhap + rsNhap!SoLuong
                rsTon.Update
            End If
            rsNhap.MoveNext
        Loop
    End If
    If rsXuat.RecordCount > 0 Then
        rsXuat.MoveFirst
        Do Until rsXuat.EOF
            If rsXuat!NgayLap > NgayCuoiThang Then Exit Do
            If rsXuat!NgayLap >= NgayDauThang Then
                rsTon.Seek "=", rsXuat!MaHang
                If rsTon.NoMatch Then
                    rsTon.AddNew
                    rsTon!MaHang = rsXuat!MaHang
                    rsTon.Update
                    rsTon.Bookmark = rsTon.LastModified
                End If
                rsTon.Edit
                rsTon!Xuat = rsTon!Xuat + rsXuat!SoLuong
                rsTon.Update
            End If
            rsXuat.MoveNext
        Loop
    End If
    
'Tinh Ton Cuoi Ky
    rsTon.MoveFirst
    Do Until rsTon.EOF
        rsTon.Edit
        rsTon!TonCuoi = rsTon!TonDau + rsTon!Nhap - rsTon!Xuat        
        rsTon.Update
        rsTon.MoveNext
    Loop 
    rsNhap.Close: rsXuat.Close: rsTon.Close
End Function 


  
  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

• RE: Dùng VBA để tính tồn kho

  hugox03 > 24-06-13, 01:42 PM

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

• RE: Dùng VBA để tính tồn kho

  Xuân Thanh > 24-06-13, 03:13 PM

  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à

• RE: Dùng VBA để tính tồn kho

  Xuân Thanh > 25-06-13, 02:28 PM

  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

• RE: Dùng VBA để tính tồn kho

  bvchauthanh > 23-07-15, 04:15 PM

  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
  

  Mã PHP:

  rsTon.Bookmark = rsTon.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

• RE: Dùng VBA để tính tồn kho

  bnvhai > 06-10-17, 03:57 PM

  (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

• RE: Dùng VBA để tính tồn kho

  bnvhai > 06-10-17, 03:59 PM

  (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

• RE: Dùng VBA để tính tồn kho

  ongke0711 > 12-10-17, 12:53 AM

  (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] 


• RE: Dùng VBA để tính tồn kho

  Xuân Thanh > 04-07-18, 03:19 PM

  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
• Bài trước Bài tiếp