「代码」SQL查询汇总EXCEL表数据：出入库统计增加上年库存统计并按名称排序
文摘
教育
2024-10-28 23:15
江苏
1、在工作表“名单表”里，命令按钮点击事件，调用mySum 过程：
Private Sub CmdSum_Click() Call mySumEnd Sub
2、在myModule模块里，mySum过程，查询汇总数据：
第一部分，定义变量，建立数据库连接，编写SQL查询语句等：
Sub mySum() ' Dim sql1 As String, sql2 As String, sql3 As String, sql As String, tbl As String, dbs As String Dim ws As Worksheet, rng As Range Dim conn As Object, rs As Object, strConn As String Dim currYear As Integer On Error Resume Next '获取用户输入的查询年份，默认为当前年份 currYear = InputBox("请输入查询年份：", "输入", Year(Date)) '设置数据库和表名 dbs = ThisWorkbook.FullName tbl = "[出入库明细$]" '创建数据库连接和记录集对象 Set conn = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset") strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & dbs '查询上年库存 sql1 = "SELECT 名称, (SUM(入库) - SUM(出库)) AS 上年库存 " & _ "FROM " & tbl & " " & _ "WHERE YEAR(日期) < " & currYear & " " & _ "GROUP BY 名称" '查询本年库存 sql2 = "SELECT 名称, SUM(入库) AS 入库, SUM(出库) AS 出库, " & _ "(SUM(入库) - SUM(出库)) AS 本年库存 " & _ "FROM " & tbl & " " & _ "WHERE YEAR(日期) <= " & currYear & " " & _ "GROUP BY 名称" '合并查询结果 sql = "SELECT b.名称, a.上年库存, b.入库, b.出库, b.本年库存 " & _ "FROM (" & sql2 & ") AS b " & _ "LEFT JOIN (" & sql1 & ") AS a ON a.名称 = b.名称" '计算合计 sql3 = "SELECT '合计' AS 名称, SUM(上年库存) AS 上年库存, " & _ "SUM(入库) AS 入库, SUM(出库) AS 出库, " & _ "SUM(本年库存) AS 本年库存 " & _ "FROM (" & sql & ")" sql = sql & " UNION ALL " & sql3
第二部分，执行查询，把记录集对象存入目标工作表，设置单元格格式： '打开连接并执行查询 conn.Open strConn rs.CursorType = 3 rs.Open sql, conn '设置输出工作表 Set ws = ThisWorkbook.Sheets("库存汇总表") With ws '清除旧数据 .Range("F3").Resize(.UsedRange.Rows.Count - 2, 5).Cells.Clear '设置结果输出范围 Set rng = .Range("F3").Resize(rs.RecordCount, 5) With rng .CopyFromRecordset rs ' 从记录集中复制数据 .Columns(1).HorizontalAlignment = xlCenter ' 设置列对齐方式 .Borders.LineStyle = 1 ' 添加边框 .Rows(.Rows.Count).Interior.Color = RGB(255, 160, 122) ' 设置最后一行颜色 .Rows(.Rows.Count).Font.Bold = True ' 设置最后一行字体加粗 .Cells(.Rows.Count, 3).Offset(1) = "上次统计时间：" & Format(Date, "yyyy年m月d日") ' 添加统计时间 End With End With '关闭记录集和连接 rs.Close conn.Close Set rs = Nothing Set conn = Nothing MsgBox "Done!"End Sub
![]()
| 安利小店
安利的牙膏非常不错，用了以后就不想再用其他的了；洗洁精、洗衣液也是日常必备，用过都说好！ |
![]()
| 合谷医疗
合谷医疗专攻各种疑难杂症，尤其擅长腰颈椎疾病、儿童神经发育异常、多动症、自闭孤独症治疗，可谓神乎其技！体验过的直呼早点来就好了！ |
![]()
| 我的付费知识星球：Excel活学活用
帮助VBA初学者提高VBA编程水平，欢迎加入！
|
喜欢就点个赞、点在看、留言评论、分享一下呗！感谢支持！
