账龄分析表在企业催收应收账款业务中提供了决策依据，大部分ERP系统者都能提供此类报表，上节中我们有了未收款的应收账款，制作账龄分析很方便。
首先我们做一个账龄区间的表，自行定义账龄划分区间，从小到大排列。
账龄分析表的格式如下图：
账龄划分区间是不固定的，我们需要循环读出每一个区间，填充到表头。
下面构造SQL字符串：
先提取未收款明细数据，就是上节的内容，这里只需要客户代码、名称、结算方式，逾期天数和应收款余额：
sql = "select b.FNumber ,b.FName, d.FHeadSelfI0452 as FSettle,"
sql = sql & "datediff(day,d.fsettledate,GETDATE()) as FDays, "
sql = sql & "a.FRemainAmount "
sql = sql & "from t_RP_Contact a "
sql = sql & "left join t_Organization b on a.FCustomer =b.FItemID "
sql = sql & "left join ICSale d on a.FInvoiceID =d.FInterID "
sql = sql & "where a.frp = 1 And a.ftype = 3 And a.FRemainAmount <> 0"把上面的明细数据作为数据源进行分列：
'按划分区间天数进行分列
str = "Select FNumber,FName,FSettle"
'未到期
str = str & ",Case When FDays<=0 THEN FRemainAmount ELSE 0 END AS F_1"
For i = 1 To UBound(arr)
If i = 1 Then
str = str & ",Case When FDays<=" & arr(i, 1) & " AND FDays>0 THEN FRemainAmount ELSE 0 END AS F0"
Else
str = str & ",Case When FDays<=" & arr(i, 1) & " AND FDays>" & arr(i - 1, 1) & " THEN FRemainAmount ELSE 0 END AS F" & arr(i - 1, 1)
End If
Next
'最后一个超期的
str = str & ",Case When FDays>" & arr(i - 1, 1) & " THEN FRemainAmount ELSE 0 END AS F" & arr(i - 1, 1)
'合计列
sql = str & ",FRemainAmount From (" & sql & ") x"这里要注意要分出”未到期“的和最后”超期“的，还有最后的合计金额。
分列后，再根据客户汇总：
'按客户汇总
str = "Select FNumber,FName,FSettle"
For i = 1 To UBound(arr)
If i = 1 Then
str = str & ",SUM(F_1),SUM(F0)"
Else
str = str & ",SUM(F" & arr(i - 1, 1) & ")"
End If
Next
str = str & ",SUM(F" & arr(i - 1, 1) & ")"
sql = str & ",SUM(FRemainAmount) From (" & sql & ") y Group By FNumber,FName,FSettle order by FName"这样，我们就构造了一个完整的账龄分析的SQL语句。执行操作后，再对报表进行格式就可以了。
结果如下图：
我们只要更改账龄划分区间，就可以马上得到新的账龄分析表：
罗马不是一天建成的，学习更是如此。如果要熟练掌握查询语句，必须大量的练习。先模仿，再举一反三，才能融会贯通。在练习过程中如果有不明白的地方可以在评论区留言，我们共同探讨。
附源码：
Option Explicit
Private Sub CommandButton1_Click()
Dim ado As Object
Dim rst As Object
Dim str As String
Dim sql As String
Dim dbIP As String
Dim dbsa As String
Dim dbpwd As String
Dim dbname As String
Dim arr As Variant
Dim rs As Integer, cs As Integer
Dim i As Integer
'清屏
Range("6:" & Rows.Count).Clear
'清除原来设置的划分区间
Range("E3:Z5").Clear
'读取划分区间到内存
arr = Sheet14.Range("A2:A" & Sheet14.Range("A" & Rows.Count).End(xlUp).Row)
'设置表头划分区间
For i = 1 To UBound(arr)
If i = 1 Then
Cells(5, 4 + i) = arr(i, 1) & "天以内"
Else
Cells(5, 4 + i) = arr(i - 1, 1) & "--" & arr(i, 1) & "天"
End If
Next
Cells(5, 4 + i) = arr(i - 1, 1) & "以上"
Cells(4, 5 + i) = "合计"
Range(Cells(4, 5 + i), Cells(5, 5 + i)).Merge
Range("E4") = "超期"
Range("E4:E4").Resize(1, i).Merge
cs = 5 + i
'如果有自动筛选，先取消自动筛选
If ActiveSheet.AutoFilterMode Then Range("A5").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
'构造提取数据的SQL语句开始***************************************************
'提取明细数据
sql = "select b.FNumber ,b.FName, d.FHeadSelfI0452 as FSettle,"
sql = sql & "datediff(day,d.fsettledate,GETDATE()) as FDays, "
sql = sql & "a.FRemainAmount "
sql = sql & "from t_RP_Contact a "
sql = sql & "left join t_Organization b on a.FCustomer =b.FItemID "
sql = sql & "left join ICSale d on a.FInvoiceID =d.FInterID "
sql = sql & "where a.frp = 1 And a.ftype = 3 And a.FRemainAmount <> 0"
'按划分区间天数进行分列
str = "Select FNumber,FName,FSettle"
'未到期
str = str & ",Case When FDays<=0 THEN FRemainAmount ELSE 0 END AS F_1"
For i = 1 To UBound(arr)
If i = 1 Then
str = str & ",Case When FDays<=" & arr(i, 1) & " AND FDays>0 THEN FRemainAmount ELSE 0 END AS F0"
Else
str = str & ",Case When FDays<=" & arr(i, 1) & " AND FDays>" & arr(i - 1, 1) & " THEN FRemainAmount ELSE 0 END AS F" & arr(i - 1, 1)
End If
Next
'最后一个超期的
str = str & ",Case When FDays>" & arr(i - 1, 1) & " THEN FRemainAmount ELSE 0 END AS F" & arr(i - 1, 1)
'合计列
sql = str & ",FRemainAmount From (" & sql & ") x"
'按客户汇总
str = "Select FNumber,FName,FSettle"
For i = 1 To UBound(arr)
If i = 1 Then
str = str & ",SUM(F_1),SUM(F0)"
Else
str = str & ",SUM(F" & arr(i - 1, 1) & ")"
End If
Next
str = str & ",SUM(F" & arr(i - 1, 1) & ")"
sql = str & ",SUM(FRemainAmount) From (" & sql & ") y Group By FNumber,FName,FSettle order by FName"
'构造提取数据的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
rs = Range("A" & Rows.Count).End(xlUp).Row
'先设置报表标题
With Range(Cells(3, 1), Cells(5, cs))
.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(Cells(6, 1), Cells(rs, cs))
.Font.Name = "宋体" '字体名称
.Font.Name = "Calibri" '数字使用的字体名称
.Font.Size = 10 '字体大小
.VerticalAlignment = xlCenter '垂直居中
End With
'设置表格
With Range(Cells(3, 1), Cells(rs, cs))
.Borders.LineStyle = 1 '网格线为实线
.Borders.Color = RGB(221, 221, 221) '网格线颜色
End With
'设置行高
With Range("3:" & rs)
.RowHeight = 18 '行间距为18
End With
'设置数字格式
With Range(Cells(6, 4), Cells(rs, cs))
.NumberFormatLocal = "0.00;[红色]-0.00;;" '数字格式为2位小数，为0时不显示
End With
'合计行公式
Range(Cells(3, 4), Cells(3, cs)).NumberFormatLocal = "0.00;-0.00;;"
Range(Cells(3, 4), Cells(3, cs)).Formula = "=SUBTOTAL(9,D6:D" & rs & ")"
'提取数据后加上自动筛选
Range("A5").Resize(1, cs).AutoFilter
End Sub