请帮忙完善出入库表中的结存数量和金额等，多谢？

TSGRH

请帮忙完善出入库表中的结存数量和金额等，多谢？
1）        现进出存明细表对同一名称及规格商品同一天有多次进出记录的结余数量 结余单价 结余金额计算不正确，没有按进出顺序（ID）计算，而是先进后出。
        因结余金额不准备确，导致出库单价和金额了不对。
        排列顺序为同一名称及规格商品,日期,明细记录ID顺序（单据号不用理）计算结余和下条出库
        出库单价为上一条记录的结存单价
       
2）        根据A入库金额交叉表 B出库金额交叉表等4个交叉表或已出明细生成表 生成这个一个的查询表或报表，样式见附表
       
3）        最好能对出入库单领料单等补充空行（每页10行）
       
4）        主表窗体中的查询名称及规格时可以根据类别下拉联动 。

祥见附件，万分感谢！

jack5d

1. Private Sub Command33_Click()
   
2.     On Error GoTo Err_Command33_Click
   
3. 
   
4.     Dim stDocName As String
   
5. 
   
6.     '  stDocName = ChrW(29983) & ChrW(25104) & ChrW(26126) & ChrW(32454) & ChrW(-30616) & ChrW(-248) & ChrW(27714) & ChrW(21161) & ChrW(-30616) & ChrW(-247)
   
7.     '  DoCmd.OpenQuery stDocName, acNormal, acEdit
   
8. 
   
9.     Dim rss01 As New ADODB.Recordset, rss02 As New ADODB.Recordset
   
10.     Dim x001(5) As String, x002(5) As Double
    
11. 
    
12. 
    
13. 
    
14.     x001(0) = "Select 妀 from 隴牉桶 Where 妀 is not null group by 妀 "
    
15. 
    
16.     rss01.Open x001(0), CurrentProject.Connection, adOpenStatic, adLockReadOnly
    
17. 
    
18.     If rss01.EOF = False Then
    
19.         rss01.MoveFirst
    
20. 
    
21.         Do Until rss01.EOF = True
    
22. 
    
23.             x001(1) = rss01("妀")
    
24. 
    
25. 
    
26.             x001(0) = "SELECT 隴牉桶.踱杅講, 隴牉桶.踱踢塗, 隴牉桶.堤踱杅講, 隴牉桶.賦豻杅講, 隴牉桶.賦豻踢塗 "
    
27.             x001(0) = x001(0) & Chr(10) & "FROM 等擂瘍 INNER JOIN 隴牉桶 ON 等擂瘍.等擂瘍 = 隴牉桶.等擂瘍 "
    
28.             x001(0) = x001(0) & Chr(10) & "WHERE 隴牉桶.妀 = '" & x001(1) & "' "
    
29.             x001(0) = x001(0) & Chr(10) & "ORDER BY 等擂瘍., IIf(Nz(隴牉桶.踱杅講)>0,0,1), 等擂瘍.等擂瘍, 隴牉桶.ID;"
    
30. 
    
31.             rss02.Open x001(0), CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    
32. 
    
33.             If rss02.EOF = False Then
    
34. 
    
35.                 rss02.MoveFirst
    
36. 
    
37.                 x002(1) = 0    '暮翹杅講
    
38.                 x002(2) = 0
    
39.                 x002(3) = 0
    
40.                 x002(4) = 0
    
41.                 Do Until rss02.EOF = True
    
42. 
    
43.                     If Nz(rss02("&#63541;踱杅講")) <> 0 Then
    
44.                         '桶靡絞&#63325;峈&#63541;踱暮翹,郔疑腔源宒,岆猁衄珨跺趼僇懂梓妎ㄛ絞&#63325;暮翹岆&#63541;踱遜岆堤踱濬腔
    
45.                         x002(1) = x002(1) + Nz(rss02("&#63541;踱杅講"))    '絞&#63325;賦湔講
    
46. 
    
47.                         x002(2) = x002(2) + Round(Nz(rss02("&#63541;踱踢塗")), 2)    '絞&#63325;賦湔踢塗
    
48. 
    
49.                         rss02("賦豻杅講") = x002(1)
    
50.                         rss02("賦豻踢塗") = x002(2)
    
51.                     Else
    
52.                         '森揭峈堤踱濬腔揭燴
    
53. 
    
54.                         x002(4) = x002(1) - Nz(rss02("堤踱杅講"))
    
55. 
    
56. 
    
57.                         x002(3) = IIf(x002(4) = 0, x002(2), Round(Nz(rss02("堤踱杅講")) * x002(2) / x002(1), 2))    '堤踱踢塗
    
58.                         
    
59.                         x002(1) = x002(1) - Nz(rss02("堤踱杅講"))    '絞&#63325;賦湔講
    
60.                         
    
61. 
    
62.                         rss02("&#63541;踱踢塗") = x002(3)
    
63. 
    
64.                         x002(2) = x002(2) - x002(3)
    
65. 
    
66. 
    
67.                         rss02("賦豻杅講") = x002(1)
    
68.                         rss02("賦豻踢塗") = x002(2)
    
69. 
    
70. 
    
71.                     End If
    
72.                     rss02.Update
    
73. 
    
74. 
    
75.                     rss02.MoveNext
    
76.                 Loop
    
77. 
    
78. 
    
79. 
    
80. 
    
81.             End If
    
82. 
    
83.             rss02.Close
    
84. 
    
85. 
    
86. 
    
87. 
    
88.             rss01.MoveNext
    
89.         Loop
    
90. 
    
91. 
    
92. 
    
93. 
    
94. 
    
95. 
    
96. 
    
97. 
    
98. 
    
99.     End If
    
100. 
     
101. 
     
102. 
     
103.     rss01.Close
     
104. 
     
105. 
     
106. 
     
107. 
     
108. DoCmd.OpenQuery "堤&#63541;踱隴牉", acViewNormal
     
109. 
     
110. 
     
111. 
     
112. 
     
113. Exit_Command33_Click:
     
114. 
     
115.    Set rss01 = Nothing
     
116.    Set rss02 = Nothing
     
117.    Erase x001
     
118.    Erase x002
     
119.    
     
120.     Exit Sub
     
121. 
     
122. Err_Command33_Click:
     
123.     MsgBox Err.Description
     
124.     Resume Exit_Command33_Click
     
125. 
     
126. End Sub

复制代码

你直接把上一段代碼貼上來看看, 我繁體亂碼看不到

jack5d

根据A入库金额交叉表等4个交叉表或已出明细生成表 生成这个格式的查询表或报表
怎麼理解? 是根據A入库金额交叉表等4个交叉表 還是 根據已出明细生成表

TSGRH

你好，麻烦在我附中加上代码吧，多谢！ 交叉表可以从入库金额交叉表等4个交叉表提前，也可以从已出明细生成表中提取。最好从已出明细生成表这样取数会快些。结果达到我附件中交叉表样式行了、

TSGRH

Private Sub Command14_Click()
    On Error GoTo Err_Command14_Click

    Dim stDocName As String

    stDocName = ChrW(-28709) & ChrW(20986) & ChrW(23384)
    DoCmd.OpenQuery stDocName, acNormal, acEdit

Exit_Command14_Click:
    Exit Sub

Err_Command14_Click:
    MsgBox Err.Description
    Resume Exit_Command14_Click

End Sub
Private Sub Command15_Click()
    On Error GoTo Err_Command15_Click

    Dim stDocName As String

    stDocName = ChrW(21333) & ChrW(25454) & ChrW(21495) & ChrW(32) & ChrW(26597) & ChrW(-29726)
    DoCmd.OpenQuery stDocName, acNormal, acEdit

Exit_Command15_Click:
    Exit Sub

Err_Command15_Click:
    MsgBox Err.Description
    Resume Exit_Command15_Click

End Sub
Private Sub Command16_Click()
    On Error GoTo Err_Command16_Click

    Dim stDocName As String

    stDocName = ChrW(-28709) & ChrW(20986) & ChrW(23384)
    DoCmd.OpenReport stDocName, acPreview

Exit_Command16_Click:
    Exit Sub

Err_Command16_Click:
    MsgBox Err.Description
    Resume Exit_Command16_Click

End Sub
Private Sub Command17_Click()
    On Error GoTo Err_Command17_Click

    Dim stDocName As String
    Dim stLinkCriteria As String

    stDocName = ChrW(21333) & ChrW(25454) & ChrW(21495)
    DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Command17_Click:
    Exit Sub

Err_Command17_Click:
    MsgBox Err.Description
    Resume Exit_Command17_Click

End Sub
Private Sub Command18_Click()
    On Error GoTo Err_Command18_Click

    Dim stDocName As String

    stDocName = ChrW(26356) & ChrW(26032) & ChrW(26126) & ChrW(32454)
    DoCmd.RunMacro stDocName

Exit_Command18_Click:
    Exit Sub

Err_Command18_Click:
    MsgBox Err.Description
    Resume Exit_Command18_Click

End Sub
Private Sub Command19_Click()
    On Error GoTo Err_Command19_Click

    Dim stDocName As String

    stDocName = ChrW(29289) & ChrW(26009) & ChrW(-30616)
    DoCmd.RunMacro stDocName

Exit_Command19_Click:
    Exit Sub

Err_Command19_Click:
    MsgBox Err.Description
    Resume Exit_Command19_Click

End Sub
Private Sub 每月进出汇总表_Click()
    On Error GoTo Err_每月进出汇总表_Click

    Dim stDocName As String

    stDocName = ChrW(-28709) & ChrW(20986) & ChrW(23384) & ChrW(26597) & ChrW(-29726)
    DoCmd.OpenQuery stDocName, acNormal, acEdit

Exit_每月进出汇总表_Click:
    Exit Sub

Err_每月进出汇总表_Click:
    MsgBox Err.Description
    Resume Exit_每月进出汇总表_Click

End Sub
Private Sub Command22_Click()
    On Error GoTo Err_Command22_Click

    Dim stDocName As String

    stDocName = ChrW(-28709) & ChrW(20986) & ChrW(23384) & ChrW(26597) & ChrW(-29726)
    DoCmd.OpenQuery stDocName, acNormal, acEdit

Exit_Command22_Click:
    Exit Sub

Err_Command22_Click:
    MsgBox Err.Description
    Resume Exit_Command22_Click

End Sub
Private Sub Command23_Click()
    On Error GoTo Err_Command23_Click

    Dim stDocName As String

    stDocName = ChrW(25353) & ChrW(26376) & ChrW(27719) & ChrW(24635) & ChrW(26597) & ChrW(-29726)
    DoCmd.OpenQuery stDocName, acNormal, acEdit

Exit_Command23_Click:
    Exit Sub

Err_Command23_Click:
    MsgBox Err.Description
    Resume Exit_Command23_Click

End Sub
Private Sub Command24_Click()
    On Error GoTo Err_Command24_Click

    Dim stDocName As String

    stDocName = ChrW(26356) & ChrW(26032) & ChrW(26126) & ChrW(32454)
    DoCmd.RunMacro stDocName

Exit_Command24_Click:
    Exit Sub

Err_Command24_Click:
    MsgBox Err.Description
    Resume Exit_Command24_Click

End Sub
Private Sub Command25_Click()
    On Error GoTo Err_Command25_Click

    Dim stDocName As String

    stDocName = ChrW(25353) & ChrW(26085) & ChrW(27719) & ChrW(24635) & ChrW(-28709) & ChrW(20986) & ChrW(23384)
    DoCmd.OpenQuery stDocName, acNormal, acEdit

Exit_Command25_Click:
    Exit Sub

Err_Command25_Click:
    MsgBox Err.Description
    Resume Exit_Command25_Click

End Sub
Private Sub Command26_Click()
    On Error GoTo Err_Command26_Click

    Dim stDocName As String

    stDocName = ChrW(26126) & ChrW(32454) & ChrW(-30616)
    DoCmd.OpenReport stDocName, acPreview

Exit_Command26_Click:
    Exit Sub

Err_Command26_Click:
    MsgBox Err.Description
    Resume Exit_Command26_Click

End Sub
Private Sub Command27_Click()
    On Error GoTo Err_Command27_Click

    Dim stDocName As String

    stDocName = ChrW(26356) & ChrW(26032) & ChrW(26126) & ChrW(32454)
    DoCmd.RunMacro stDocName

Exit_Command27_Click:
    Exit Sub

Err_Command27_Click:
    MsgBox Err.Description
    Resume Exit_Command27_Click

End Sub
Private Sub Command29_Click()
    On Error GoTo Err_Command29_Click

    Dim stDocName As String
    Dim stLinkCriteria As String

    stDocName = ChrW(-28709) & ChrW(20986) & ChrW(20179) & ChrW(31383) & ChrW(20307)
    DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Command29_Click:
    Exit Sub

Err_Command29_Click:
    MsgBox Err.Description
    Resume Exit_Command29_Click

End Sub
Private Sub Command30_Click()
    On Error GoTo Err_Command30_Click

    Dim stDocName As String

    stDocName = ChrW(49) & ChrW(20837) & ChrW(24211) & ChrW(21333)
    DoCmd.OpenReport stDocName, acPreview

Exit_Command30_Click:
    Exit Sub

Err_Command30_Click:
    MsgBox Err.Description
    Resume Exit_Command30_Click

End Sub
Private Sub Command31_Click()
    On Error GoTo Err_Command31_Click

    Dim stDocName As String

    stDocName = ChrW(50) & ChrW(20986) & ChrW(24211) & ChrW(21333)
    DoCmd.OpenReport stDocName, acPreview

Exit_Command31_Click:
    Exit Sub

Err_Command31_Click:
    MsgBox Err.Description
    Resume Exit_Command31_Click

End Sub
Private Sub Command32_Click()
    On Error GoTo Err_Command32_Click

    Dim stDocName As String

    stDocName = ChrW(51) & ChrW(-28709) & ChrW(20986) & ChrW(23384)
    DoCmd.OpenReport stDocName, acPreview

Exit_Command32_Click:
    Exit Sub

Err_Command32_Click:
    MsgBox Err.Description
    Resume Exit_Command32_Click

End Sub
Private Sub Command33_Click()
    On Error GoTo Err_Command33_Click

    Dim stDocName As String

    '  stDocName = ChrW(29983) & ChrW(25104) & ChrW(26126) & ChrW(32454) & ChrW(-30616) & ChrW(-248) & ChrW(27714) & ChrW(21161) & ChrW(-30616) & ChrW(-247)
    '  DoCmd.OpenQuery stDocName, acNormal, acEdit

    Dim rss01 As New ADODB.Recordset, rss02 As New ADODB.Recordset
    Dim x001(5) As String, x002(5) As Double



    x001(0) = "Select 商品 from 明细表 Where 商品 is not null group by 商品 "

    rss01.Open x001(0), CurrentProject.Connection, adOpenStatic, adLockReadOnly

    If rss01.EOF = False Then
        rss01.MoveFirst

        Do Until rss01.EOF = True

            x001(1) = rss01("商品")


            x001(0) = "SELECT 明细表.入库数量, 明细表.入库金额, 明细表.出库数量, 明细表.结余数量, 明细表.结余金额 "
            x001(0) = x001(0) & Chr(10) & "FROM 单据号 INNER JOIN 明细表 ON 单据号.单据号 = 明细表.单据号 "
            x001(0) = x001(0) & Chr(10) & "WHERE 明细表.商品 = '" & x001(1) & "' "
            x001(0) = x001(0) & Chr(10) & "ORDER BY 单据号.日期, IIf(Nz(明细表.入库数量)>0,0,1), 单据号.单据号, 明细表.ID;"

            rss02.Open x001(0), CurrentProject.Connection, adOpenKeyset, adLockOptimistic

            If rss02.EOF = False Then

                rss02.MoveFirst

                x002(1) = 0    '记录数量
                x002(2) = 0
                x002(3) = 0
                x002(4) = 0
                Do Until rss02.EOF = True

                    If Nz(rss02("入库数量")) <> 0 Then
                        '表名当前为入库记录,最好的方式,是要有一个字段来标识，当前记录是入库还是出库类的
                        x002(1) = x002(1) + Nz(rss02("入库数量"))    '当前结存量

                        x002(2) = x002(2) + Round(Nz(rss02("入库金额")), 2)    '当前结存金额

                        rss02("结余数量") = x002(1)
                        rss02("结余金额") = x002(2)
                    Else
                        '此处为出库类的处理

                        x002(4) = x002(1) - Nz(rss02("出库数量"))


                        x002(3) = IIf(x002(4) = 0, x002(2), Round(Nz(rss02("出库数量")) * x002(2) / x002(1), 2))    '出库金额
                        
                        x002(1) = x002(1) - Nz(rss02("出库数量"))    '当前结存量
                        

                        rss02("入库金额") = x002(3)

                        x002(2) = x002(2) - x002(3)


                        rss02("结余数量") = x002(1)
                        rss02("结余金额") = x002(2)


                    End If
                    rss02.Update


                    rss02.MoveNext
                Loop




            End If

            rss02.Close




            rss01.MoveNext
        Loop









    End If



    rss01.Close




DoCmd.OpenQuery "出入库明细", acViewNormal




Exit_Command33_Click:

   Set rss01 = Nothing
   Set rss02 = Nothing
   Erase x001
   Erase x002
   
    Exit Sub

TSGRH

代码我复上了，老师。多谢帮忙！

jack5d

我想問一句, 這系統是你自己做的還是改別人的?
你的問題:
1)問題一定出在VBA計算過程中, 但我還是沒看明白你VBA在做什麼, 為何不能用ACCESS查詢去完成呢?
2)你要做匯總不是這樣做的你誤用交叉查詢了, 現實中你用inner join遠遠比交叉來的方便清楚, 你就給我一個一個欄去計算, 最後inner join 一起, 比如說, 你要計算[16年10月31日期末数数量], 你建一表就單單給我查出2個欄 1)商品, 2) 期末数数量, 接著再建一表查[客戶退貨數量]...等等 全建好了, 最後建一表以[商品]為主鍵把所有資料join 一起就完事了, 這樣做, 日後數據有錯, 就可以有一個一個獨立的表來知道錯在哪!

3)最好能对出入库单领料单等补充空行（每页10行） -- 可以做到每頁10行, 但不能以空行填上, 除非你能做到數據源查出結果, 不足10筆時以NULL值填入致10筆, SQL是可以的, ACCESS對不起我不知道
每頁10行的方法很簡單, VBA中count記錄, 是10的倍數時就把[強行換頁控件]顯示出來, 否則就不顯示

4)主表窗体中的查询名称及规格时可以根据类别下拉联动 -- 這個簡單, 見附件
Database1.rar (35.91 KB, 下载次数: 11)

2016-11-15 12:46 上传

点击文件名下载附件

TSGRH

你好，老师。代码，不是我写的。是网友帮我的。问题1最好能在查询中完成。问题2，你能我使SQL 整个吧 问题3 4      也帮我在附件中加上吧                           另我用有还是ACCESS 2003 能将附近帮我转换下再上传吗？多谢！

jack5d

你要去找當初給你寫的人去改了,
因為簡繁轉換, 過程命名等都亂碼了, 我根沒法在你程序內修改...

TSGRH

OK,多谢！可惜原来人没来帮。