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

最新推荐文章于 2025-02-16 12:37:49 发布

原创最新推荐文章于 2025-02-16 12:37:49 发布 · 4.5k 阅读

14 ·

本内容遵循CC 4.0 BY-SA版权协议

收录于

VBA

本文介绍如何利用VBA高效地将一个包含大量数据的Excel表格拆分为多个小表格。通过创建样表并运行VBA代码，可以实现一键拆分，例如将一个表格拆分为7个小表格。此外，还探讨了按行数拆分，如每10行作为一个新表格的方法。

背景：业务给了一个大表格，里面几十万条数据，要拆分成成百上千个小表格，思来想去，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

运行结果如下：
在这里插入图片描述
一个表格拆成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

标签

#vba #excel