自动测算生物资产账面净值和折旧-雨泉专栏

最近一段时间，因为工作需要，自己编写了一个牛奶生物资产账面净值和当月折旧的自动计算软件，选定截止日期，点击刷新按钮后，用时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 ("成功！ ")