热门标签 | HotTags
当前位置:  开发笔记 > 编程语言 > 正文

VBA将一个表格拆分成多个新表格

背景:业务给了一个大表格,里面几十万条数据,要拆分成成百上千个小表格,思来想去,vba做这件事是效率最高的。样表数据源:请按照这个表头在excel中制作样表(最好将样表放在一个空文

背景:业务给了一个大表格,里面几十万条数据,要拆分成成百上千个小表格,思来想去,vba做这件事是效率最高的。

样表数据源:
《VBA将一个表格拆分成多个新表格》
请按照这个表头在excel中制作样表(最好将样表放在一个空文件夹里面)
然后调出VB编辑器,输入如下代码运行

Sub 按A列区分内容并拆分到新表格()
Dim i%
arr = Sheets(1).[a1].CurrentRegion
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr)
If d.exists(arr(i, 1)) Then '判断key是否存在
Set d(arr(i, 1)) = Union(d(arr(i, 1)), Rows(i)) '如果存在则将前面相同key的行和当前key对应的行合并成一个对象
Else
Set d(arr(i, 1)) = Union(Rows(1), Rows(i)) '如果不存在则把表头拿过来和当前行合并成一个对象
End If
Next i
For ss = 0 To d.Count - 1
Workbooks.Add
With ActiveWorkbook
d.items()(ss).Copy .Sheets(1).[a1] '将列A每一个值对应的行单独拿出来,粘贴复制到一个新表格
.SaveAs ThisWorkbook.Path & "/" & d.keys()(ss) '每个新表格的名字是列A的每一个值
.Close
End With
Next ss
MsgBox "工作薄拆分完毕!"
End Sub

运行结果如下:
《VBA将一个表格拆分成多个新表格》
一个表格拆成7个小表格

补充第二个情景:
按照每10行做为一个表格,切分成多个表格

Sub 按A列区分内容并拆分到新表格()
Dim i%
arr = Sheets(1).[a1].CurrentRegion
For i = 2 To UBound(arr)
If i Mod 10 = 0 Then
Workbooks.Add
With ActiveWorkbook
Union(Workbooks("test.xlsx").Sheets(1).Range("a1:e1"), Workbooks("test.xlsx").Sheets(1).Range("a" & (i - 9) & ":e" & i)).Copy .Sheets(1).[a1]
.SaveAs ThisWorkbook.Path & "/" & i
.Close
End With
End If
Next i
MsgBox "工作薄拆分完毕!"
End Sub

推荐阅读
author-avatar
高度的寂寞
这个家伙很懒,什么也没留下!
PHP1.CN | 中国最专业的PHP中文社区 | DevBox开发工具箱 | json解析格式化 |PHP资讯 | PHP教程 | 数据库技术 | 服务器技术 | 前端开发技术 | PHP框架 | 开发工具 | 在线工具
Copyright © 1998 - 2020 PHP1.CN. All Rights Reserved | 京公网安备 11010802041100号 | 京ICP备19059560号-4 | PHP1.CN 第一PHP社区 版权所有