按月自动生成一个新的分客户统计表格

jaxpqh

　　我有一个订单总表，要求用VBA代码实现按月自动统计每个客户的应收款金额，并汇总该月的总金额，生成的表格以年月命名保存在同一个文件夹中。

jaxpqh

表格内容如下。

lcluck2002

2022年10月--1216.zip

fzxba

Sub test1()
  Dim Conn As Object, rs As Object
  Dim p As String, f As String, s As String
  p = ThisWorkbook.Path & "\分簿\"
  If Dir(p, vbDirectory) = "" Then MkDir p
  Set Conn = CreateObject("ADODB.Connection")
  Set rs = CreateObject("ADODB.Recordset")
  Conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 XML;Data Source=" & ThisWorkbook.FullName
  s = "SELECT DISTINCT FORMAT(送货日期,'YYYY年MM月') FROM [" & ActiveSheet.Name & "$] WHERE LEN(送货日期)"
  rs.Open s, Conn, 1, 3
  While Not rs.EOF
    s = rs.Fields(0).Value
    f = p & s & ".xlsx"
    If Dir(f) <> "" Then Kill f
    Conn.Execute "SELECT 客户名称,SUM(应收金额) AS 金额 INTO [" & f & "].[" & s & "] FROM [" & ActiveSheet.Name & "$] WHERE FORMAT(送货日期,'YYYY年MM月')='" & s & "' GROUP BY 客户名称"
    rs.MoveNext
  Wend
  rs.Close
  Set rs = Nothing
  Conn.Close
  Set Conn = Nothing
  Beep
End Sub

125675117

lcluck2002 发表于 2022-12-16 08:56
2022年10月--1216.zip

好像不行呢，运行了没有结果

笨鸟飞不高

订单.zip (64.86 KB, 下载次数: 38)

2022-12-16 10:07 上传

点击文件名下载附件

lcluck2002

125675117 发表于 2022-12-16 09:27
好像不行呢，运行了没有结果

soor,是我的失误，没有把汇总表也放在一起，导致提示打开汇总表失败。

ykcbf1100

测试通过。

cysczhumh

笨鸟飞不高 发表于 2022-12-16 10:07

运行正确，符合要求！

jaxpqh

ykcbf1100 发表于 2022-12-16 10:20
测试通过。

　　谢谢！
　　数据多的时候，这样会对以前的数据进行更改。比如１０月我已经导出了，现在不想重复导出，我只想导出１１月份的，也就是说我可以指定导出某一个月的，要求弹出对话框，由我自己输入”××××年××月“，然后就导出该月的数据。
　　还有一个不足，没有对该月所有数据进行汇总。
　　麻烦老师帮我修改一下，拜托了！