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.hbovkf.icu/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宏鵬

發表評論您的評論將提升作者分享的動力!快來評論一下吧!

用戶名:
密 碼:
內 容:
 

常見問答

技術分類

相關資源

關于我們 | 服務條款 | 在線投稿 | 友情鏈接 | 網站統計 | 網站幫助