Excel VBA应用-8：制作同比环比分析报表

上一节我们演示了如何制作周期销售汇总表，本节我们在上节的基础上再进行一些变化，制作按月份的同比环比分析表，具体格式如下：

取值分析：

同比是上一年度相同月份与本月之比，当前分析年度是2022年，那同比取值就是2021年；

环比是上月与本月之比，取值范围是2021年12月到2022年11月；

整个报表需要取值的范围就是2021年1月至2022年12月。

字段分析：由于涉及到年度，我们需要用函数构造出一个年度的字段，并按客户，年度，月度分组合计。

SQL语句如下：

Select a.FCustID,YEAR(a.fdate) AS FYear,MONTH(a.fdate) AS FMonth,SUM(b.famount) AS FAmt From ICSale a LEFT JOIN ICSaleEntry b on a.FInterID=b.FInterID WHERE YEAR(a.fdate) IN (2021,2022) Group By a.FCustID,YEAR(a.fdate),MONTH(a.fdate)

从上面的报表格式中我们可以看出，分析报表有12个月和1个合计，每个月份有5列，分别是当月，上年同期，同比增长率，上期，环比增长率。共有1（客户）+13*5=66列。

先看1月份的情况，其他月份可以仿照1月编写：

本期：

CASE WHEN x.FYear=2022 AND x.FMonth=1 THEN x.FAmt ELSE 0 END AS M11

上年同期：

CASE WHEN x.FYear=2021 AND x.FMonth=1 THEN x.FAmt ELSE 0 END AS M12

上期：

CASE WHEN x.FYear=2021 AND x.FMonth=12 THEN x.FAmt ELSE 0 END AS M13

这里CASE WHEN 写法与上节的不一样，当只有一个条件且为等于时，可以写成：

CASE x.FMonth WHEN 1 THEN x.FAmt ELSE 0 END AS M1

如果有多个条件，直接写在WHEN后面。

数据分列后，我们就可以构造出最后的数据列：

本期求和：SUM(M11) 上年同期求和：SUM(M12) 上年同期增长率： CASE WHEN SUM(M12)=0 THEN 0 ELSE (SUM(M11)-SUM(M12))/SUM(M12) END 上期求和：SUM(M13) 上期增长率： CASE WHEN SUM(M13)=0 THEN 0 ELSE (SUM(M11)-SUM(M13))/SUM(M13) END

由于字符串较长，为了不出现编写错误，我们用循环语句来构造字符串。

最后的结果如下：

罗马不是一天建成的，学习更是如此。如果要熟练掌握查询语句，必须大量的练习。先模仿，再举一反三，才能融会贯通。在练习过程中如果有不明白的地方可以在评论区留言，我们共同探讨。

附源码：

Option Explicit Private Sub CommandButton1_Click() Dim ado As Object Dim rst As Object Dim str As String Dim sql As String Dim s As String Dim y As Integer, y1 As Integer, i As Integer Dim dbIP As String Dim dbsa As String Dim dbpwd As String Dim dbname As String Dim rs As Integer '清屏 Range("6:" & Rows.Count).Clear '如果没有录入查询年度和月份，退出 If Val(Range("B1")) = 0 Then Exit Sub '如果有自动筛选，先取消自动筛选 If ActiveSheet.AutoFilterMode Then Range("A4").AutoFilter '设置数据库连接字符串 dbIP = "(local)" '安装数据库的电脑IP地址，(local)代表本机 dbsa = "sa" 'SQLServer数据库的登录用户名 dbpwd = "123456" 'SQLServer数据库的登录密码 dbname = "AIS20210318095953" '需要提取数据的金蝶数据库名 str = "Provider=SQLOLEDB.1;" str = str & "Data Source=" & dbIP & ";" str = str & "Persist Security Info=True;" str = str & "User ID=" & dbsa & ";" str = str & "Password=" & dbpwd & ";" str = str & "Initial Catalog=" & dbname & ";" '建立数据库连接 Set ado = CreateObject("ADODB.Connection") ado.Open str y = Range("B1") y1 = y - 1 '构造提取数据的SQL语句开始*************************************************** '提取明细数据 sql = "Select a.FCustID,YEAR(a.fdate) AS FYear,MONTH(a.fdate) AS FMonth,SUM(b.famount) AS FAmt " sql = sql & "From ICSale a LEFT JOIN ICSaleEntry b on a.FInterID=b.FInterID " sql = sql & "WHERE YEAR(a.fdate) IN (" & y1 & "," & y & ") " sql = sql & "Group By a.FCustID,YEAR(a.fdate),MONTH(a.fdate)" '构造本期，上年同期，上期数据 s = "Select x.FCustID" For i = 1 To 12 '本期 s = s & ",CASE WHEN x.FYear=" & y & " AND x.FMonth=" & i & " THEN x.FAmt ELSE 0 END AS M" & i & "1" '上年同期 s = s & ",CASE WHEN x.FYear=" & y1 & " AND x.FMonth=" & i & " THEN x.FAmt ELSE 0 END AS M" & i & "2" '上期 If i = 1 Then s = s & ",CASE WHEN x.FYear=" & y1 & " AND x.FMonth=" & 12 & " THEN x.FAmt ELSE 0 END AS M" & i & "3" Else s = s & ",CASE WHEN x.FYear=" & y & " AND x.FMonth=" & i - 1 & " THEN x.FAmt ELSE 0 END AS M" & i & "3" End If Next s = s & ",CASE WHEN x.FYear=2022 THEN x.FAmt ELSE 0 END AS Y1" s = s & ",CASE WHEN x.FYear=2021 THEN x.FAmt ELSE 0 END AS Y2" sql = s & " From (" & sql & ") x" '分组求和 s = "Select c.FName" For i = 1 To 12 s = s & ",SUM(M" & i & "1),SUM(M" & i & "2),CASE WHEN SUM(M" & i & "2)=0 THEN 0 " s = s & "ELSE (SUM(M" & i & "1)-SUM(M" & i & "2))/SUM(M" & i & "2) END" s = s & ",SUM(M" & i & "3),CASE WHEN SUM(M" & i & "3)=0 THEN 0 " s = s & "ELSE (SUM(M" & i & "1)-SUM(M" & i & "3))/SUM(M" & i & "3) END" Next s = s & ",SUM(Y1),SUM(Y2),CASE WHEN SUM(Y2)=0 THEN 0 ELSE (SUM(Y1)-SUM(Y2))/SUM(Y2) END" sql = s & " From (" & sql & ") y LEFT JOIN t_Organization c on y.FCustID=c.FItemID " sql = sql & "Group By c.FName Order By SUM(y.Y1) DESC" '构造提取数据的SQL语句结束*************************************************** Set rst = ado.Execute(sql) If Not rst.EOF Then Range("A6").CopyFromRecordset rst rst.Close Set rst = Nothing Set ado = Nothing '*******************设置报表格式******************* '取消工作表显示网格线 ActiveWindow.DisplayGridlines = False '先设置报表标题 With Range("A3:BL5") .Font.Name = "微软雅黑" '字体名称 .Font.Size = 10 '字体大小 .Font.Color = RGB(255, 255, 255) '字体颜色 .Interior.Color = RGB(72, 99, 156) '背景色 .HorizontalAlignment = xlCenter '水平居中 .VerticalAlignment = xlCenter '垂直居中 End With '设置表体格式 With Range("A6:BL" & Range("A" & Rows.Count).End(xlUp).Row) .Font.Name = "宋体" '字体名称 .Font.Name = "Calibri" '数字使用的字体名称 .Font.Size = 10 '字体大小 .VerticalAlignment = xlCenter '垂直居中 End With '设置表格 With Range("A3:BL" & Range("A" & Rows.Count).End(xlUp).Row) .Borders.LineStyle = 1 '网格线为实线 .Borders.Color = RGB(221, 221, 221) '网格线颜色 End With '设置行高 With Range("3:" & Range("A" & Rows.Count).End(xlUp).Row) .RowHeight = 18 '行间距为18 End With '设置数字格式 With Range("B6:BL" & Range("A" & Rows.Count).End(xlUp).Row) .NumberFormatLocal = "0;;;" '数字格式为2位小数，为0时不显示 End With '设置增长率格式 For i = 1 To 12 Range("B3,C3,E3").Offset(0, (i - 1) * 5).Formula = "=SUBTOTAL(9,OFFSET(B6:B" & Range("A" & Rows.Count).End(xlUp).Row & ",0," & (i - 1) * 5 & "))" Range("D3").Offset(0, (i - 1) * 5).Formula = "=OFFSET(B3,0," & (i - 1) * 5 & ")/OFFSET(C3,0," & (i - 1) * 5 & ")" Range("D3").Offset(0, (i - 1) * 5).NumberFormatLocal = "[红色]0.00%↑;[绿色]-0.00%↓;;" Range("F3").Offset(0, (i - 1) * 5).Formula = "=OFFSET(B3,0," & (i - 1) * 5 & ")/OFFSET(E3,0," & (i - 1) * 5 & ")" Range("F3").Offset(0, (i - 1) * 5).NumberFormatLocal = "[红色]0.00%↑;[绿色]-0.00%↓;;" Range("D6:D" & Range("A" & Rows.Count).End(xlUp).Row).Offset(0, (i - 1) * 5).NumberFormatLocal = "[红色]0.00%↑;[绿色]-0.00%↓;;" Range("D6:D" & Range("A" & Rows.Count).End(xlUp).Row).Offset(0, (i - 1) * 5 + 2).NumberFormatLocal = "[红色]0.00%↑;[绿色]-0.00%↓;;" Next Range("D6:D" & Range("A" & Rows.Count).End(xlUp).Row).Offset(0, (i - 1) * 5).NumberFormatLocal = "[红色]0.00%↑;[绿色]-0.00%↓;;" End Sub