Đánh giá chủ đề:
  • 0 Votes - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Dùng VBA để tính tồn kho
#1
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 IntegerNam 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
.ClosersXuat.ClosersTon.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
Chữ ký của Xuân Thanh Trăm năm trước thì ta chưa gặp
Trăm năm sau biết gặp được không?
Cuộc đời sắc sắc không không
Thì thôi ta cứ hết lòng vì nhau
ღღღღღTài sản của Xuân Thanh (View All Items) ღღღღღ
Reply
Những người đã cảm ơn hugox03 , nguyenchinh228 , maidinhdan
#2
bạn Xuân Thanh có thể up file demo cho mình tham khảo trực tiếp được không ?
ღღღღღTài sản của hugox03 (View All Items) ღღღღღ
Reply
Những người đã cảm ơn
#3
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à
ღღღღღTài sản của Xuân Thanh (View All Items) ღღღღღ
Reply
Những người đã cảm ơn hugox03
#4
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 IntegerNam 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
.ClosersTon.Close
End 
Function 

Thân mến
ღღღღღTài sản của Xuân Thanh (View All Items) ღღღღღ
Reply
Những người đã cảm ơn hugox03 , maidinhdan , bvchauthanh
#5
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 rose
Chữ ký của bvchauthanh
rose"Luôn luôn lắng nghe
Lâu lâu mới.... hiểu." rose
Reply
Những người đã cảm ơn


Có thể liên quan đến chủ đề
Chủ đề: Tác giả Trả lời: Xem: Bài mới nhất
  [Hàm] Demo_[Hàm] Tính thâm niên như BHXH (maidinhdan) maidinhdan 18 2,255 08-05-16, 09:20 PM
Bài mới nhất: maidinhdan
  Hướng Dẫn Tổng hợp các hàm Toán học nâng cao: thống kê, xác xuất, tuyến tính..(Ví dụ) maidinhdan 0 179 16-04-16, 01:15 PM
Bài mới nhất: maidinhdan
  [Hàm] Một số hàm liên quan đến ngày tháng và tính toán Xuân Thanh 2 938 20-03-15, 11:36 AM
Bài mới nhất: Xuân Thanh
  Sử dụng thư viện hàm của Excel trong Access Noname 4 5,752 14-02-15, 01:45 PM
Bài mới nhất: thucgia
  [Hàm] Hàm HenNgay để tính ngày kẻ từ ngày bắt đầu đến ngày có số ngày hẹn cho trước Xuân Thanh 8 1,826 15-05-14, 09:46 AM
Bài mới nhất: cawboy

Chuyển nhanh:


User(s) browsing this thread: 1 Guest(s)
Diễn Đàn Thơ Văn Thi Ẩm Lâu|Nhà Hàng Sông Thơ