存货明细账自动登记与打印(请帮我设置本月合计、本季合计、本年合计)

mickey5772

问题还是没有解决，数据显示不全，只显示到6月份，有些还漏掉了一两项数据，而出现了负库存，麻烦楼主再帮我看一下，楼主能不能解释一下思路。添加的辅助列有什么作用。谢谢了

[ 本帖最后由 mickey5772 于 2010-9-1 21:39 编辑 ]

leibin1981

存货明细账自动登记与打印

hyz00001

辅助列好像没有什么作用。
主要的还是SMALL函数和index函数。
至于只到六月份就没有了，我建议你看看是不是某个地方的绝对应用或者相对应用的问题。

asjm

你好的，正是我想要的~~
但对代码不了解~~~能帮我做一下吗？

hyz00001

我也不知道，你还是请教侠圣先生吧。

张志云

楼主问题解决了没有。懒笨之人要吃白食

中原一布衣

9楼的方法不错！值得参考！！只是不知道数据量大时速度怎么样？

hyz00001

gly1126 发表于 2010-4-24 11:47
VBA+ADO+SQL解法

感谢你，这个太强大了。

1. Sub mxz()
   
2.     Dim conn As New ADODB.Connection
   
3.     Dim rst As New ADODB.Recordset
   
4.     conn.Open "dsn=excel files;dbq=" & ThisWorkbook.FullName
   
5.     Application.ScreenUpdating = False
   
6.     With Worksheets("mxz")
   
7.         '清空明细账
   
8.         .UsedRange.Offset(3, 0).ClearContents
   
9.         '取年初数据
   
10.         Set rst = conn.Execute("select ' ',' ','上年结转',0,0,0,0,期初数量,期初金额 from [期初数据$] where 页码='" & UCase(.Range("i1")) & "' and 期初金额<>0")
    
11.         .Range("a65536").End(xlUp).Offset(1, 0).CopyFromRecordset rst
    
12.         '取明细数据
    
13.         Set rst = conn.Execute("select 日期,凭证号,摘要,借方数量,借方金额,贷方数量,贷方金额,0,0 from [09年度数据$] where 页码='" & UCase(.Range("i1")) & "' order by 日期,凭证号")
    
14.         .Range("a65536").End(xlUp).Offset(1, 0).CopyFromRecordset rst
    
15.         '计算余额
    
16.         If .Range("c4") <> "上年结转" Then .Range("h4") = .Range("d4"): .Range("i4") = .Range("e4")
    
17.         For i = 5 To .Range("a65536").End(xlUp).Row
    
18.             .Cells(i, 8) = .Cells(i - 1, 8) + .Cells(i, 4) - .Cells(i, 6)
    
19.             .Cells(i, 9) = .Cells(i - 1, 9) + .Cells(i, 5) - .Cells(i, 7)
    
20.         Next i
    
21.         '取本月合计
    
22.         Set rst = conn.Execute("select max(日期),'','本月合计',SUM(借方数量),SUM(借方金额),SUM(贷方数量),SUM(贷方金额),0,0 from [09年度数据$] where 页码='" & UCase(.Range("i1")) & "' and (借方金额<>0 OR 贷方金额<>0) group by month(日期) order by 1")
    
23.         .Range("a65536").End(xlUp).Offset(1, 0).CopyFromRecordset rst
    
24.         '取本季累计
    
25.         '一季度
    
26.         Set rst = conn.Execute("select max(日期),'','本季累计',SUM(借方数量),SUM(借方金额),SUM(贷方数量),SUM(贷方金额),0,0 from [09年度数据$],(select distinct month(日期) as rq from [09年度数据$] where month(日期) in(1,2,3)) as ljrq where 页码='" & UCase(.Range("i1")) & "' and (借方金额<>0 OR 贷方金额<>0) and month(日期)<=rq and month(日期) in(1,2,3) group by rq order by 1")
    
27.         .Range("a65536").End(xlUp).Offset(1, 0).CopyFromRecordset rst
    
28.         '二季度
    
29.         Set rst = conn.Execute("select max(日期),'','本季累计',SUM(借方数量),SUM(借方金额),SUM(贷方数量),SUM(贷方金额),0,0 from [09年度数据$],(select distinct month(日期) as rq from [09年度数据$] where month(日期) in(4,5,6)) as ljrq where 页码='" & UCase(.Range("i1")) & "' and (借方金额<>0 OR 贷方金额<>0) and month(日期)<=rq and month(日期) in(4,5,6) group by rq order by 1")
    
30.         .Range("a65536").End(xlUp).Offset(1, 0).CopyFromRecordset rst
    
31.         '三季度
    
32.         Set rst = conn.Execute("select max(日期),'','本季累计',SUM(借方数量),SUM(借方金额),SUM(贷方数量),SUM(贷方金额),0,0 from [09年度数据$],(select distinct month(日期) as rq from [09年度数据$] where month(日期) in(7,8,9)) as ljrq where 页码='" & UCase(.Range("i1")) & "' and (借方金额<>0 OR 贷方金额<>0) and month(日期)<=rq and month(日期) in(7,8,9) group by rq order by 1")
    
33.         .Range("a65536").End(xlUp).Offset(1, 0).CopyFromRecordset rst
    
34.         '四季度
    
35.         Set rst = conn.Execute("select max(日期),'','本季累计',SUM(借方数量),SUM(借方金额),SUM(贷方数量),SUM(贷方金额),0,0 from [09年度数据$],(select distinct month(日期) as rq from [09年度数据$] where month(日期) in(10,11,12)) as ljrq where 页码='" & UCase(.Range("i1")) & "' and (借方金额<>0 OR 贷方金额<>0) and month(日期)<=rq and month(日期) in(10,11,12) group by rq order by 1")
    
36.         .Range("a65536").End(xlUp).Offset(1, 0).CopyFromRecordset rst
    
37.         '取本年累计
    
38.         Set rst = conn.Execute("select max(日期),'','本年累计',SUM(借方数量),SUM(借方金额),SUM(贷方数量),SUM(贷方金额),0,0 from [09年度数据$],(select distinct month(日期) as rq from [09年度数据$]) as ljrq where 页码='" & UCase(.Range("i1")) & "' and (借方金额<>0 OR 贷方金额<>0) and month(日期)<=rq group by rq order by 1")
    
39.         .Range("a65536").End(xlUp).Offset(1, 0).CopyFromRecordset rst
    
40.         '明细账排序
    
41.         .UsedRange.Offset(3, 0).Sort Key1:=Range("A4"), Header:=xlGuess
    
42.     End With
    
43.     Application.ScreenUpdating = True
    
44. End Sub
    

复制代码

jhzghua

留个记号,可能会用