在各行各业的日常工作中,经常需要把一份工作表的内容归类拆分到N个工作簿,最基础的办法就是通过筛选、排序归类数据,然后复制原数据,再新建工作簿,粘贴数据,如此往复......如果数量较小,这样操作没问题,如果分类的数据非常多,要新建几百,几千个工作簿,那就是一个非常大的工作量了。
此时就需要使用批量处理的方法,可以用PQ,也可以用VBA,本文就分享用VBA来处理批量拆分工作簿,用VBA的好处在于,只要代码写好,不需要懂代码,任何人都可以直接拿来用,其他办法就需要对软件操作有一些要求了。
以下图这个表格为例:
工作场景:这是一位学员给我提出的问题,她说这个表格每个星期要做一次,需要把这个表格按A列的店铺名称归类到一起然后拆分到工作簿,A列中有几个店就要拆分成几个工作簿,并且还要保留原来的批注图片,拆分出来的工作簿名称以店铺名称命名。
这个问题的关键点:
1、A列的店铺是无序的
2、保留表格中的批注图片
3、工作簿命名为对应的店铺名称
OK,问题描述清楚了,那就开始讲解VBA操作步骤。
1、首先表格需要打开宏设置,点击文件——Excel选项——信任中心——信任中心设置——宏设置——启用所有宏,然后点击确定。
这个步骤,每台电脑只要设置过一次,以后都默认开启,如果你以前用过VBA那这个步骤可以略过。
2、鼠标放在原数据所在的工作表,点击鼠标右键,查看代码,进入VBA编辑界面
将代码复制到上图所示的区域中。
复制下面的代码↓↓↓↓↓↓(黑色加粗部分)
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
Set d(arr(i, 1)) = Union(d(arr(i, 1)), Rows(i))
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]
.SaveAs ThisWorkbook.Path & "/" & d.keys()(ss)
.Close
End With
Next ss
MsgBox "快学Excel提示您,工作薄拆分完毕!"
End Sub
3、点击运行(点击绿色三角形),代码运行时,屏幕会闪烁,拆分出来的新工作簿会放在原工作簿的路径里。如果原工作簿放在一个文件夹,那新拆分出来的工作簿也会在这个文件夹里,如果原工作簿放在桌面,那拆分出来的工作簿就会放在桌面上。当拆分完毕时,会弹出提示框,表明代码运行完毕。
拆分完毕后,新工作薄以店铺名称命名
拆分完后随意打开一张看一下,店铺名称已经归类拆分好了,并且批注图片保留下来了。
上面的案例所用的代码默认表格的格式为:表头一行,拆分依据为A列
1、如果我的表头是一行,但是我以B列为依据拆分应该如何对代码进行调整呢?
把代码的这4处(下图中红框标记处)修改为2
如果以C列为拆分依据就修改成3,以此类推。
2、如果我的表头是多行并且表头有合并单元格怎么改代码?
如下图所示,表头是2行,并且有合并单元格,以B列为拆分依据
表头有合并单元对代码运行没有任何影响,无需针对这个修改代码。
表头如果是两行需要对代码,上面红框处把2修改成3,下面红框处rows(1)修改成rows("1:2")
如果表头是3行,上面红框就修改成4,下面红框处就修改成rows("1:3") 以此类推。
好了关于如何用VBA拆分工作簿就分享到这里,如果这篇文章能帮助到你请点赞,收藏,你的点赞是我继续创作的动力。
本文由快学excel原创,欢迎大家关注。