根据期初及出入库明细，生成各产品的不同表单的不合并的统计汇总

anywhere99

求助大神：

根据产品期初数据、产品出库、产品入库，生成各产品的汇总总表、各产品的以不同表单的期初\入库、出库的汇总罗列，有多少款产品就生成多少个表单。

详见附件，还请多多指教

anywhere99

求助大神指教

ykcbf1100

难是不难，就是费时间。

shiruiqiang

个人一直感觉，自己表格做的好，后期减少自己很多工作量。lz把出入库做成流水账，自己嫩减轻很多活。
1、只需要几个函数
2、出入库流水一目了然
3、统计部分月份啥的，只需筛选等
4、可以统计哪几个销量高低
5、可以给以后转数据库做准备
。。。。。。。

fzxba

1. Sub test1() '汇总 测试
   
2. 
   
3.   Dim Conn As Object, SQL As String, strConn As String, i As Long
   
4.   Dim A As String, B As String, C As String
   
5.   
   
6.   Set Conn = CreateObject("ADODB.Connection")
   
7.   If Application.Version < 12 Then
   
8.     strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source="
   
9.   Else
   
10.     strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source="
    
11.   End If
    
12.   Conn.Open strConn & ThisWorkbook.FullName
    
13.   
    
14.   Worksheets("汇总").Activate
    
15.   ActiveSheet.UsedRange.Offset(1).ClearContents
    
16.   
    
17.   A = "SELECT 品名,期初 FROM [期初$] WHERE 品名 IS NOT NULL"
    
18.   B = "SELECT 品名,SUM(数量) AS 入库总数量 FROM [入库$] WHERE 品名 IS NOT NULL GROUP BY 品名"
    
19.   C = "SELECT 品名,SUM(数量) AS 出库总数量,SUM(金额) AS 出库总金额 FROM [出库$] WHERE 品名 IS NOT NULL GROUP BY 品名"
    
20.   
    
21.   SQL = "SELECT a.品名 AS 名称,a.期初,b.入库总数量,c.出库总数量,c.出库总金额,b.入库总数量-c.出库总数量 AS 结余 FROM " & _
    
22.         "((" & A & ") a LEFT JOIN (" & B & ") b ON a.品名=b.品名 ) LEFT JOIN (" & C & ") c ON a.品名=c.品名"
    
23.   Range("A2").CopyFromRecordset Conn.Execute(SQL)
    
24.   
    
25.   Conn.Close
    
26.   Set Conn = Nothing
    
27.   Beep
    
28. End Sub
    
29. 
    
30. Sub test2() '拆分 测试
    
31. 
    
32.   Dim Conn As Object, rs As Object, SQL As String
    
33.   Dim wks As Worksheet, Fields_, pos As Long
    
34.   Dim A As String, B As String, C As String
    
35.   Dim strConn As String, str_ As String
    
36.   
    
37.   DoApp False
    
38.   
    
39.   For Each wks In Worksheets
    
40.     If wks.Index > 4 Then wks.Delete
    
41.   Next
    
42.   
    
43.   Set Conn = CreateObject("ADODB.Connection")
    
44.   Set rs = CreateObject("ADODB.Recordset")
    
45.   If Application.Version < 12 Then
    
46.     strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source="
    
47.   Else
    
48.     strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source="
    
49.   End If
    
50.   Conn.Open strConn & ThisWorkbook.FullName
    
51.   
    
52.   Fields_ = Split("商品名称 入货日期 入货数量 出货日期 出货数量 出库金额")
    
53.   A = "SELECT 品名,'期初',期初 FROM [期初$] WHERE 品名='[str_]'"
    
54.   B = "SELECT 品名 AS 商品名称,日期 AS 入货日期,数量 AS 入货数量 FROM [入库$] WHERE 品名='[str_]' ORDER BY 日期"
    
55.   C = "SELECT 日期 AS 出货日期,数量 AS 出货数量余,小计 AS 出库金额 FROM [出库$] WHERE 品名='[str_]' ORDER BY 日期"
    
56.   
    
57.   SQL = "SELECT DISTINCT 品名 FROM [入库$] WHERE 品名 IS NOT NULL"
    
58.   rs.Open SQL, Conn, 1, 3
    
59.   
    
60.   While Not rs.EOF
    
61.     str_ = rs.Fields(0).Value
    
62.     Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = str_
    
63.     With ActiveSheet
    
64.       .Range("B1") = "入库"
    
65.       .Range("E1") = "出库"
    
66.       .Range("B2").Resize(, UBound(Fields_) + 1) = Fields_
    
67.       .Range("B3").CopyFromRecordset Conn.Execute(Replace(A, "[str_]", str_))
    
68.       .Range("B4").CopyFromRecordset Conn.Execute(Replace(B, "[str_]", str_))
    
69.       .Range("E4").CopyFromRecordset Conn.Execute(Replace(C, "[str_]", str_))
    
70.       .Columns.AutoFit
    
71.       pos = .Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row + 1
    
72.       .Cells(pos, "B") = "小计"
    
73.       .Cells(pos, "D") = "=sum(r4c:r[-1]c)"
    
74.       .Cells(pos, "F") = "=sum(r4c:r[-1]c)"
    
75.       .Cells(pos, "G") = "=sum(r4c:r[-1]c)"
    
76.       With .Range("B1").CurrentRegion
    
77.         .Columns(2).NumberFormatLocal = "YYYY/M/D"
    
78.         .Columns(4).NumberFormatLocal = "YYYY/M/D"
    
79.         .Borders.LineStyle = xlContinuous
    
80.         .HorizontalAlignment = xlCenter
    
81.       End With
    
82.       .Range("B1").Resize(, 3).HorizontalAlignment = xlCenterAcrossSelection
    
83.       .Range("E1").Resize(, 3).HorizontalAlignment = xlCenterAcrossSelection
    
84.     End With
    
85.     rs.MoveNext
    
86.   Wend
    
87.   
    
88.   rs.Close
    
89.   Set rs = Nothing
    
90.   Conn.Close
    
91.   Set Conn = Nothing
    
92.   
    
93.   Worksheets("汇总").Activate
    
94.   DoApp
    
95.   Beep
    
96. End Sub
    
97. 
    
98. Function DoApp(Optional Flag As Boolean = True)
    
99.   With Application
    
100.     .ScreenUpdating = Flag
     
101.     .DisplayAlerts = Flag
     
102.     .Calculation = -Flag * 30 - 4135
     
103.   End With
     
104. End Function

复制代码

fzxba

仅供测试.zip (35.91 KB, 下载次数: 20)

2024-3-29 11:27 上传

点击文件名下载附件

jjmysjg

ykcbf1100 发表于 2024-3-28 20:25
难是不难，就是费时间。

期待结果，谢谢

yanglinzi

期初怎会没有金额