按照条件拆分多个独立工作薄

小丸子jun · 发表于 2018-7-8 18:10

根据条件拆分多个独立工作薄，希望每次拆分独立工作薄同时，我在原表无论有多个小工作表都随着拆分独立工作薄放在一起的。例子请看图片

lenghonghai601 · 发表于 2018-7-8 19:54

Sub test()
Dim cnn As Object, arr, i&, wb As Workbook, sh As Worksheet
Set cnn = CreateObject("adodb.connection")
cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
mysql = "select 类别,sum(数量),sum(金额) from [数据源$] group by 类别"
arr = WorksheetFunction.Transpose(cnn.Execute(mysql).getrows)
cnn.Close
For i = 1 To UBound(arr)
Set wb = Workbooks.Add
Set sh = wb.Sheets(1)
sh.Range("a1").Resize(1, 3) = Array("类别", "数量", "金额")
sh.Range("a2") = arr(i, 1): sh.Range("b2") = arr(i, 2): sh.Range("c2") = arr(i, 3)
wb.SaveAs ThisWorkbook.Path & "" & arr(i, 1) & ".xls"
wb.Close True
Next i
End Sub

复制代码

opiona · 发表于 2018-7-9 08:38

LMY123 · 发表于 2018-7-9 09:20

多表同时拆分

小丸子jun · 发表于 2018-7-9 14:52

lenghonghai601 发表于 2018-7-8 19:54

亲，已经实现是第一步按照类别拆分，最后重点我是想透视表也随着拆分一起。我附件里面有一个文件是达成想要效果例子，你看下是否能实现。

sjh4030 · 发表于 2018-7-9 18:24

小丸子jun 发表于 2018-7-9 14:52
亲，已经实现是第一步按照类别拆分，最后重点我是想透视表也随着拆分一起。我附件里面有一个文件是达成想 ...

sjh4030 · 发表于 2018-7-9 18:24

sjh4030 发表于 2018-7-9 18:24
http://club.excelhome.net/thread-1222700-1-1.html

chxw68老师写的代码或许能帮助你

sjh4030 · 发表于 2018-7-9 18:30

拆分.zip (22.15 KB, 下载次数: 8)

		自动登录	找回密码
密码			免费注册

[求助] 按照条件拆分多个独立工作薄