注册 登录
Office中国论坛/Access中国论坛 返回首页

todaynew的个人空间 http://www.office-cn.net/?144436 [收藏] [复制] [分享] [RSS]

日志

多种存货计价方式集成

热度 3已有 3485 次阅读2009-4-23 13:19 |个人分类:习作|



Private Sub 计算_Click()
If IsNull(Me.物资ID.Value) Then Exit Sub
Select Case Me.选项
    Case 1    '先进先出法
        先后法
    Case 2    '后进先出法
        先后法
    Case 3    '移动平均法
        移动法
    Case 4    '加权平均法
        加权法
End Select
Me.收发存子窗体.Form.Requery
End Sub


Private Sub 先后法()
Dim rs1 As New ADODB.Recordset
Dim sql1 As String
Dim rs2 As New ADODB.Recordset
Dim sql2 As String
Dim 收料数量 As Single
Dim 发料数量 As Single
Dim 累计金额 As Single
Dim 收发余额 As Single
sql1 = "select * from 发料查询 where format(日期,'yymm')='" & Me.月度.Value & "'and 物资ID=" & Me.物资ID.Value
rs1.Open sql1, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
If Me.选项.Value <> 2 Then
    sql2 = "select * from 库存及收料查询 where format(日期,'yymm')='" & Me.月度.Value & "'and 物资ID=" & Me.物资ID.Value
Else
    sql2 = "select * from 库存及收料查询 where format(日期,'yymm')='" & Me.月度.Value & "'and 物资ID=" & Me.物资ID.Value & " ORDER BY 编号 DESC"
End If
rs2.Open sql2, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
收发余额 = 0
Do While Not (rs1.EOF)
    If 收发余额 > 0 Then
        收料数量 = 收发余额
        收发余额 = 0
    Else
        收料数量 = rs2("数量")
    End If
    If rs1("数量") < 收料数量 Then
        rs1("单价") = rs2("单价")
        rs1("金额") = rs1("数量") * rs1("单价")
        rs1.Update
        收发余额 = 收料数量 - rs1("数量")
    Else
        累计金额 = 0
        发料数量 = rs1("数量")
        Do While Not (rs2.EOF)
            累计金额 = 累计金额 + 收料数量 * rs2("单价")
            发料数量 = 发料数量 - 收料数量
            rs2.MoveNext
            收料数量 = rs2("数量")
            If 发料数量 < 收料数量 Then
                累计金额 = 累计金额 + 发料数量 * rs2("单价")
                rs1("金额") = 累计金额
                rs1("单价") = Round(rs1("金额") / rs1("数量"), 2)
                rs1.Update
                收发余额 = rs2("数量") - 发料数量
                Exit Do
            End If
        Loop
    End If
    rs1.MoveNext
Loop
Me.收发子窗体.Form.Requery
rs1.Close
rs2.Close
End Sub

Private Sub 移动法()
Dim rs1 As New ADODB.Recordset
Dim sql1 As String
Dim rs2 As New ADODB.Recordset
Dim sql2 As String
Dim 累计数量 As Single
Dim 累计金额 As Single
Dim 库存数量 As Single
Dim 库存金额 As Single
Dim i As Long
sql1 = "select * from 发料查询 where format(日期,'yymm')='" & Me.月度.Value & "'and 物资ID=" & Me.物资ID.Value
rs1.Open sql1, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
sql2 = "select * from 库存及收料查询 where format(日期,'yymm')='" & Me.月度.Value & "'and 物资ID=" & Me.物资ID.Value
rs2.Open sql2, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
库存数量 = 0
库存金额 = 0
For i = 1 To rs1.RecordCount
    累计数量 = 库存数量
    累计金额 = 库存金额
    Do While Not (rs2.EOF)
        If rs2("编号").Value < rs1("编号").Value Then
            累计数量 = 累计数量 + rs2("数量")
            累计金额 = 累计金额 + rs2("金额")
            rs2.MoveNext
        Else
            rs2.MovePrevious
            Exit Do
        End If
    Loop
        rs1("单价") = Round(累计金额 / 累计数量, 2)
        rs1("金额") = rs1("数量") * rs1("单价")
        rs1.Update
        库存数量 = 累计数量 - rs1("数量")
        库存金额 = 累计金额 - rs1("金额")
    If rs2.EOF = False Then rs2.MoveNext
    rs1.MoveNext
Next
Me.收发子窗体.Form.Requery
rs1.Close
rs2.Close
End Sub

Private Sub 加权法()
Dim rs1 As New ADODB.Recordset
Dim sql1 As String
Dim rs2 As New ADODB.Recordset
Dim sql2 As String
Dim 累计数量 As Single
Dim 累计金额 As Single
Dim 单价 As Single
sql1 = "select * from 发料查询 where format(日期,'yymm')='" & Me.月度.Value & "'and 物资ID=" & Me.物资ID.Value
rs1.Open sql1, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
sql2 = "select * from 库存及收料查询 where format(日期,'yymm')='" & Me.月度.Value & "'and 物资ID=" & Me.物资ID.Value
rs2.Open sql2, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
累计数量 = 0
累计金额 = 0
For i = 1 To rs2.RecordCount
    累计数量 = 累计数量 + rs2("数量")
    累计金额 = 累计金额 + rs2("金额")
    rs2.MoveNext
Next
单价 = Round(累计金额 / 累计数量, 2)
For i = 1 To rs1.RecordCount
    rs1("单价") = 单价
    rs1("金额") = rs1("数量") * rs1("单价")
    rs1.Update
    rs1.MoveNext
Next
Me.收发子窗体.Form.Requery
rs1.Close
rs2.Close
End Sub

刚表态过的朋友 (0 人)

发表评论 评论 (5 个评论)

回复 qczvba 2011-7-22 16:06
版主,上个实例附件,好让新人学习。谢了。
回复 todaynew 2011-7-22 16:16
qczvba: 版主,上个实例附件,好让新人学习。谢了。
有实例,在这个地址看:http://www.access-cn.com/forum-viewthread-tid-70596-highlight-%BB%EB%C8%BB%D2%BB%CC%E5.html
回复 qczvba 2011-7-22 16:21
谢谢老大及时答复,谢谢。给你添忙烦了。有问题再请教。好人一生平安。
回复 todaynew 2011-7-22 16:27
qczvba: 谢谢老大及时答复,谢谢。给你添忙烦了。有问题再请教。好人一生平安。
我党宗旨是全心全意为人民服务
回复 李力军2 2016-7-29 08:47
好东西,可以学习

facelist doodle 涂鸦板

您需要登录后才可以评论 登录 | 注册

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-25 05:38 , Processed in 0.059025 second(s), 18 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

返回顶部