excel拆分

一、前言二、准备员工信息表测试数据三、拆分三（1）：根据所在分公司列拆分为多个sheet操作步骤1. 选中要拆分的sheet,右键单击“查看代码”，如图：2. 插入如下代码：3. 运行，实现拆分为多个sheet（代码插入后，直接关闭当前代码窗口即可，无需保存）拆分后结果三（2）：根据“所在分公司”列拆分为多个单独excel文件操作步骤1.插入代码拆分后结果四、没有宏菜单，如何打开？

一、前言

作为一名运维工程师，难免会遇到各种数据库数据导出需求。最近遇到要求把导出的员工信息根据分公司分组后拆分为多个sheet工作表或多个单独的excel文件。。刚开始通过oracle数据库层面琢磨了好久，不知道怎么实现（通过where条件可以，可是分公司很多呢），好吧，，能力有限，没有倒腾出来 。于是，咱干脆从excel下手。终于功夫不负有心人，通过网上资料，一顿猛操作后，居然成功了，。特别开心，今天分享给大家，话不多说，开干哈。。。

二、准备员工信息表测试数据

三、拆分

三（1）：根据所在分公司列拆分为多个sheet

操作步骤

1. 选中要拆分的sheet,右键单击“查看代码”，如图：

2. 插入如下代码：

Sub 拆分为多个sheet文件()Dim d As Object, sht As Worksheet, arr, brr, r, kr, i&, j&, k&, x&Dim Rng As Range, Rg As Range, tRow&, tCol&, aCol&, pd&Application.ScreenUpdating = FalseApplication.DisplayAlerts = FalseSet d = CreateObject("scripting.dictionary")Set Rg = Application.InputBox("提示：请选择您要拆分的列", Title:="温馨提示", Type:=8)tCol = Rg.ColumntRow = Val(Application.InputBox("提示：请您输入表的标题总行数？"))If tRow = 0 Then MsgBox "输入错误，程序将退出！": Exit SubSet Rng = ActiveSheet.UsedRangearr = RngtCol = tCol - Rng.Column + 1aCol = UBound(arr, 2)For i = tRow + 1 To UBound(arr)If Not d.exists(arr(i, tCol)) Thend(arr(i, tCol)) = iElsed(arr(i, tCol)) = d(arr(i, tCol)) & "," & iEnd IfNextFor Each sht In WorksheetsIf d.exists(sht.Name) Then sht.DeleteNextkr = d.keysFor i = 0 To UBound(kr)If kr(i) <> "" Thenr = Split(d(kr(i)), ",")ReDim brr(1 To UBound(r) + 1, 1 To aCol)k = 0For x = 0 To UBound(r)k = k + 1For j = 1 To aColbrr(k, j) = arr(r(x), j)NextNextWith Worksheets.Add(, Sheets(Sheets.Count)).Name = kr(i).[a1].Resize(tRow, aCol) = arr.[a1].Offset(tRow, 0).Resize(k, aCol) = brrRng.Copy.[a1].PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False.[a1].SelectEnd WithEnd IfNextSheets(1).ActivateSet d = NothingErase arr: Erase brrApplication.ScreenUpdating = TrueApplication.DisplayAlerts = TrueMsgBox "拆分成功，欧耶。"End Sub

3. 运行，实现拆分为多个sheet（代码插入后，直接关闭当前代码窗口即可，无需保存）

点击excel菜单栏的开发工具-宏-选中刚才代码函数-点击运行

找不到宏，可见本文章末尾，有添加方法哟

提示请输入要拆分的列，这里我们要拆分所在分公司“这一列，所以选中A2，点击【确定】

这里我做了一个表头行数输入，比如咱们这张表，有两行作为表头，那么在提示：“请您请输入标题总行数“时，我填写的2，点击【确定】后，就开始拆分

拆分后结果

拆分结果如下图，表示本次拆分已经成功：

三（2）：根据“所在分公司”列拆分为多个单独excel文件

操作步骤

步骤与 三（1）：根据“所在分公司”列拆分为多个单独sheet文件的一样，这里就不做详细图解

excel右键-查看代码-插入代码-宏-运行。注意：在运行下面代码，提示：“请输入拆分列号”，输入列号即可。

如下图,我们要拆分的是第一列，所有输入1即可：

1.插入代码

Sub 拆分为多个excel文件()Dim arr, d As Object, k, t, i&, lc%, rng As Range, c%c = Application.InputBox("提示：请输入要拆分列号", , 3, , , , , 1)tRow = Application.InputBox("提示：请您输入表的标题总行数？")If tRow = 0 Then MsgBox "输入错误，程序将退出！": Exit SubApplication.ScreenUpdating = FalseApplication.DisplayAlerts = Falsearr = [a1].CurrentRegionlc = UBound(arr, 2)Set rng = [a1].Resize(tRow + 1, lc)Set d = CreateObject("scripting.dictionary")For i = tRow + 1 To UBound(arr)If Not d.Exists(arr(i, c)) ThenSet d(arr(i, c)) = Cells(i, 1).Resize(1, lc)ElseSet d(arr(i, c)) = Union(d(arr(i, c)), Cells(i, 1).Resize(1, lc))End IfNextk = d.Keyst = d.Itemstt = tRow + 1For i = 0 To d.Count - 1With Workbooks.Add(xlWBATWorksheet)rng.Copy .Sheets(1).[a1]t(i).Copy .Sheets(1).[a4].SaveAs Filename:=ThisWorkbook.Path & "\" & k(i) & ".xls".CloseEnd WithNextApplication.DisplayAlerts = TrueApplication.ScreenUpdating = TrueMsgBox "拆分成功，欧耶"End Sub

拆分后结果

怎么样，是不是超好用。。哈哈哈哈，还行啦。。其实还有好多小细节想完善，比如 拆分主表 “员工信息-主表”中有一个名为 备注的sheet工作表,拆分成多个分公司excel后，也想每个分公司excel表自动带有一个“备注”的sheet工作表！！！！！目前还没有研究出来，有时间再好好琢磨琢磨，到时候再更新哈，嘿嘿，哪位大神知道的话，也欢迎评论区留言哦》》》》

四、没有宏菜单，如何打开？

excel菜单的文件->选项->自定义功能区->宏，点击添加即可。