Access培训
网站公告
·Access快速平台QQ群号:277422564    ·Access快速开发平台下载地址及教程    ·欢迎添加微信交流账号:AccessoftChu    ·如何快速搜索本站文章|示例|资料    
您的位置: 首页 > 技术文章 > 财务应用

自动测算生物资产账面净值和折旧

时 间:2019-06-30 20:39:56
作 者:雨泉   ID:39037  城市:金昌
摘 要:ACCESS高效工作,实现傻瓜式运算;   
正 文:

     最近一段时间,因为工作需要,自己编写了一个牛奶生物资产账面净值和当月折旧的自动计算软件,选定截止日期,点击刷新按钮后,用时1分23秒左右实现生物资产账面净值的自动测算,奶牛当月折旧的自动测算。可以说极大的提高了工作效率,如果不会ACCESS VBA,用Excel表格对2014年到现在的牛群进行测算,可以说是个比较复杂的事情,因为五年多养殖过的奶牛超过2万头,用成本法按天核算生物资产账面价值,数据量是比较大的。
     在写代码之前,先要感谢长期以来一直给我技术辅导和帮助的盟威的各位老师,是他们从2013年以来一直耐心的给予我帮助,使我的编程技术不断娴熟;感谢chinasa的热心回帖(帖子网址:http://www.accessoft.com/bbs/showtopic.asp?Id=30941);感谢张志老师的热心帮助,是我的程序运行效率更高更快。

     代码如下(不完整,只复制了关键技术点,因为我是局域网内使用,和牛群管理软件的数据库联通,不能独立运行,所以没有添加附件):
  Dim rst As New ADODB.Recordset
  Dim startDate As String ' 开始日期,由于dlookup函数里要用作条件,需要加#号,故设置为文本型
  Dim endDate As String '断奶日期
  Dim ycDate As String '育成日期
  Dim cdDate As String '产犊日期
 '提取出生、断奶、育成、青年日期——————————————————————————————
 DoCmd.SetWarnings False '屏弊系统的警告
 CurrentDb.Execute "Delete FROM 牛群基础表"  '删除该表全部数据
 '创建ODBC链接表
 DoCmd.TransferDatabase acLink, "ODBC", "ODBC;DRIVER=SQL Server;SERVER=192.***.***.***;" & _
      "UID=sa;PWD=****;DATABASE=****;", acTable, "cow_change", "群别转换", False
 DoCmd.RunSQL "Insert INTO 牛群基础表(牛号,日期,类别,辅助) " & _
                " Select CowId,EventDate,'出生日期',CowId&EventDate&'出生日期' FROM 群别转换 " & _
                " Where EventCode='born'"
 DoCmd.RunSQL "Insert INTO 牛群基础表(牛号,日期,类别,辅助) " & _
                " Select CowId,EventDate,'断奶日期',CowId&EventDate&'断奶日期' FROM 群别转换 " & _
                " Where EventCode='Wean'"
 DoCmd.RunSQL "Insert INTO 牛群基础表(牛号,日期,类别,辅助) " & _
                " Select CowId,EventDate,'青年日期',CowId&EventDate&'断奶日期' FROM 群别转换 " & _
                " Where EventCode='GrowthChange' AND GroCode='青年牛'"
 DoCmd.RunSQL "Insert INTO 牛群基础表(牛号,日期,类别,辅助) " & _
                " Select CowId,EventDate,'育成日期',CowId&EventDate&'断奶日期' FROM 群别转换 " & _
                " Where EventCode='GrowthChange' AND GroCode='育成牛'"
 DoCmd.DeleteObject acTable, "群别转换"   '删除链接表


   DoCmd.SetWarnings False '屏弊系统的警告
   CurrentDb.Execute "Delete FROM TMP_牛只账面价值 "  '删除该表全部数据
   CurrentDb.Execute "Delete FROM TMP_牛只账面价值2 "  '删除该表全部数据
   '将牛号加载到表中
   DoCmd.RunSQL "Insert INTO TMP_牛只账面价值(牛号,出生日期) Select 牛号,日期 " & _
                " FROM 牛群基础表 Where 类别='出生日期' orDER BY 日期 ASC"
   '将离场日期加载到表中
   DoCmd.RunSQL "Update TMP_牛只账面价值, 牛群基础表 SET TMP_牛只账面价值.离场日期=牛群基础表.日期 " & _
                " Where TMP_牛只账面价值.牛号=牛群基础表.牛号 AND 牛群基础表.类别='离场日期' "
   '删除离场牛只
   CurrentDb.Execute "Delete FROM TMP_牛只账面价值 Where 离场日期<#" & Me.截止日期 & "#" '删除该表全部数据


   '将日期加载到表中
   DoCmd.RunSQL "Update TMP_牛只账面价值, 牛群基础表 SET TMP_牛只账面价值.断奶日期=牛群基础表.日期 " & _
                " Where TMP_牛只账面价值.牛号=牛群基础表.牛号 AND 牛群基础表.类别='断奶日期' "
   DoCmd.RunSQL "Update TMP_牛只账面价值, 牛群基础表 SET TMP_牛只账面价值.育成日期=牛群基础表.日期 " & _
                " Where TMP_牛只账面价值.牛号=牛群基础表.牛号 AND 牛群基础表.类别='育成日期' "
   DoCmd.RunSQL "Update TMP_牛只账面价值, 牛群基础表 SET TMP_牛只账面价值.产犊日期=牛群基础表.日期 " & _
                " Where TMP_牛只账面价值.牛号=牛群基础表.牛号 AND 牛群基础表.类别='产犊日期' " & _
                " AND 牛群基础表.胎次='1' "
   '更新落地价
   DoCmd.RunSQL "Update TMP_牛只账面价值, 牛只养殖成本 SET TMP_牛只账面价值.落地价值=牛只养殖成本.落地价 " & _
                " Where TMP_牛只账面价值.出生日期=牛只养殖成本.日期 "
   DoCmd.RunSQL "Update TMP_牛只账面价值, 牛只养殖成本 SET TMP_牛只账面价值.犊牛价值=牛只养殖成本.落地价 " & _
                " Where TMP_牛只账面价值.产犊日期=牛只养殖成本.日期 "
  


   CurrentDb.Execute "Delete FROM TMP_牛只账面价值 Where 出生日期 >#" & Me.截止日期 & "#"   '删除该表全部数据
   '为保障下面的循环求和正确,需要先把空的日期填入,这段代码是为后期再把空的日期还原准备的
   DoCmd.RunSQL "Insert INTO TMP_牛只账面价值2(牛号,出生日期,断奶日期,育成日期,产犊日期) Select 牛号,出生日期,断奶日期,育成日期,产犊日期 " & _
                " FROM TMP_牛只账面价值 orDER BY 出生日期 ASC"


   DoCmd.RunSQL "Update TMP_牛只账面价值 SET 断奶日期 = # " & Me.截止日期 & " #  Where isNull(断奶日期)"
   DoCmd.RunSQL "Update TMP_牛只账面价值 SET 育成日期 = # " & Me.截止日期 & " #  Where isNull(育成日期)"
   DoCmd.RunSQL "Update TMP_牛只账面价值 SET 产犊日期 = # " & Me.截止日期 & " #  Where isNull(产犊日期)"


   DAO.DBEngine.SetOption dbMaxLocksPerFile, 9999999
    rst.Open "TMP_牛只账面价值", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    rst.MoveFirst
    Do Until rst.EOF
        startDate = "#" & Format(rst!出生日期, "yyyy-mm-dd") & "#"
        endDate = "#" & Format(rst!断奶日期 - 1, "yyyy-mm-dd") & "#"
        ycDate = "#" & Format(rst!育成日期 - 1, "yyyy-mm-dd") & "#"
        cdDate = "#" & Format(rst!产犊日期 - 1, "yyyy-mm-dd") & "#"
        rst!哺乳价值 = DSum("哺乳", "牛只养殖成本", "日期 between " & startDate & " AND " & endDate)
        rst!断奶价值 = DSum("断奶", "牛只养殖成本", "日期 between " & endDate & " AND " & ycDate)
        rst!育青价值 = DSum("育成", "牛只养殖成本", "日期 between " & ycDate & " AND " & cdDate)
        rst.Update
        rst.MoveNext
    Loop
    rst.Close
    Set rst = Nothing


   '完成计算后,将正确日期填进去
   DoCmd.RunSQL "Update TMP_牛只账面价值, TMP_牛只账面价值2 SET TMP_牛只账面价值.断奶日期=TMP_牛只账面价值2.断奶日期, " & _
                "TMP_牛只账面价值.育成日期=TMP_牛只账面价值2.育成日期, TMP_牛只账面价值.产犊日期=TMP_牛只账面价值2.产犊日期" & _
                " Where TMP_牛只账面价值.牛号=TMP_牛只账面价值2.牛号"


   DoCmd.RunSQL "Update TMP_牛只账面价值 SET 账面价值=nz(落地价值)+nz(哺乳价值)+nz(断奶价值)+nz(育青价值)-nz(犊牛价值)"
   DoCmd.RunSQL "Update TMP_牛只账面价值 SET TMP_牛只账面价值.开始月=DateAdd('m',1,产犊日期),TMP_牛只账面价值.结束月=DateAdd('m',61,产犊日期)"
   
   DoCmd.RunSQL "Update TMP_牛只账面价值 SET TMP_牛只账面价值.净残值='10000'," & _
                " TMP_牛只账面价值.折旧开始月=YEAR(TMP_牛只账面价值.开始月)&'年'&(Month(TMP_牛只账面价值.开始月))&'月'," & _
                " TMP_牛只账面价值.折旧结束月=YEAR(TMP_牛只账面价值.结束月)&'年'&(Month(TMP_牛只账面价值.结束月))&'月'"
'省略后面的代码,因为剩下的都是简单的运算,关键技术点在上面红色部分
    Me.Requery '刷新数据
    Me.子表.Requery '刷新数据
    Me.子表.Form.AllowAdditions = False '让子窗体不出现新增行
    MsgBox ("成功! ")


Access软件网官方交流QQ群 (群号:864245409)       access源码网店

最新评论 查看更多评论(35)

2019/7/1 8:52:49宏鹏

发表评论您的评论将提升作者分享的动力!快来评论一下吧!

用户名:
密 码:
内 容:
 

常见问答

技术分类

相关资源

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助