一起学习，一起进步~~
之前我们的工作表的拆分基本上都是针对一个工作表来实现的，今天我们来提升下难度，通过一个条件，我们来同时针对多个工作表进行拆分，并且将拆分之后的结果生成独立工作薄，这个功能使用起来也是非常的强大的，能够将多个工作表的相同内容同时进行拆分，拆分之后每个内容都是一个独立工作薄，你以为拆分之后工作薄内只有一个工作表嘛？不不不，你原来有几个工作表拆分之后就是几个，不改变所有结构，仅仅是实现对内容进行拆分，一起来看看吧
场景说明
先来看看我们今天的数据源
这是我们今天的数据源，现在有4个表，分别登记了全年级几个班级最近4次的考试，现在这样的登记方式，我们能够非常清楚的针对每次的考试所有班级的成绩进行分析，但是如果我们想要针对各个班级进行分析的时候就有点困难了，因为每个班级的成绩被分布4个工作表中，每个表中还有其他的班级，没有办法针对一个班级来分析，我们可以将每个表中的班级都全部拆分出来，一个班级一个工作薄，里面含有4次的考试成绩，这样不就可以了吗？来试试
代码区
Sub chai()Dim rng As Range, sth As Worksheet, BookN As Workbook, pathn$, zd As Object, arr, crng As RangeSet zd = CreateObject("scripting.dictionary")pathn = ActiveWorkbook.PathSet sth = ActiveSheetSet rng = Application.InputBox("请选择表头区域", "表头区域的确定", , , , , , 8)TitleR = rng.Rows.CountTitleC = rng.ColumnTitleColNum = rng.Columns.CountSet crng = Application.InputBox("请选择拆分列标准列", "标准列的确定", , , , , , 8)num = crng.Column - TitleC + 1l = ActiveSheet.Cells(Rows.Count, TitleR).End(xlUp).Rowarr = Range(Cells(TitleR + 1, TitleC), Cells(l, TitleColNum + TitleC - 1))For Each sth In Worksheets For i = 1 To UBound(arr) If Not zd.exists(arr(i, num)) Then Set zd(arr(i, num)) = CreateObject("scripting.dictionary") End If If Not zd(arr(i, num)).exists(sth.Name) Then Set zd(arr(i, num))(sth.Name) = sth.Cells(i + TitleR, TitleC).Resize(1, TitleColNum) Else Set zd(arr(i, num))(sth.Name) = Union(zd(arr(i, num))(sth.Name), sth.Cells(i + TitleR, TitleC).Resize(1, TitleColNum)) End If Next iNext sthFor Each Item In zd.keys Application.SheetsInNewWorkbook = zd(Item).Count Set BookN = Workbooks.Add k = 0 With BookN For Each items In zd(Item).keys k = k + 1 With .Worksheets(k) .Name = items rng.Copy .Cells(1, 1) zd(Item)(items).Copy .Cells(TitleR + 1, 1) End With Next End With ActiveWorkbook.SaveAs pathn & "\" & Item ActiveWorkbook.Close FalseNext ItemEnd Sub来看看程序执行的过程，其实就是两个字典就解决了。
先选择表头
然后选择拆分标准列，都是套路
然后，没然后了，然后就出结果了。
和我们之前拆分成为独立工作薄一样啊，来看看工作薄里面
每个工作博内部都含有原来相同的名称的4个工作表，并且每个工作表对应的都是原来总表中数据所在的工作表，比方说这里的一班的A1(4)他在新生成的工作表中是表4的数据，那么在原工作表呢？
在原工作表中，也是在表4的位置，也就是说我们同时在4个工作表中进行了相同内容的拆分。
代码分析
前面的选择表头和标准列的部分，这里就不在讲述了，前面已经讲述过很多次了
直接进入今天的重点环节，字典+字典
对今天的重点就是两个字典，了解字典的构造过程，整个代码就很容易理解了。
首先来看第一个字典
For Each sth In Worksheets For i = 1 To UBound(arr) If Not zd.exists(arr(i, num)) Then Set zd(arr(i, num)) = CreateObject("scripting.dictionary") End If ****** Next iNext sth这里应该是比较好理解的，arr(i, num)指的是什么呢？
我们先看看数组的区域，数组很好理解，就是整个工作表的数据区就是arr的范围（不含表头），num是我们刚刚选择的拆分列，也就是班级，那么这里就很好理解了。arr(i, num)指向的就是班级列
那么这样一来，大家应该能够理解上面的代码的意思了，如果字典zd中并不存在班级这名称，则我们继续声明一个新的字典，
这个新的字典就是zd(班级名称），一班就是zd(一班）这样子
For Each sth In Worksheets For i = 1 To UBound(arr) ******* If Not zd(arr(i, num)).exists(sth.Name) Then Set zd(arr(i, num))(sth.Name) = sth.Cells(i + TitleR, TitleC).Resize(1, TitleColNum) Else Set zd(arr(i, num))(sth.Name) = Union(zd(arr(i, num))(sth.Name), sth.Cells(i + TitleR, TitleC).Resize(1, TitleColNum)) End If Next iNext sth然后再继续看下面这段字段，前面已经穿件了一个zd(一班）这样类型的字典了，不管存在还是不存在，当走到这里的时候，都肯定是存在的，然后我们将zd(一班）这样的字典再来玩一下，变成另外一个字典，zd(一班)(表一)
zd(一班）和zd(一班)(表一)这两个字典有什么关系和区别呢？
zd(一班）中含有 zd(一班)(表一)，zd(一班)(表一)是zd(一班）下面的一个小字典
sth.Cells(i + TitleR, TitleC).Resize(1, TitleColNum)这个是单元格的区域的问题，下一系列我们讲述单元格的时候会讲述到这里方法的使用，这里我们只需要了解他所指的范围就是Cells(i + TitleR, TitleC)这个单元格所在的哪一行的所有闭合区间的范围
下面半句
Set zd(arr(i, num))(sth.Name) = Union(zd(arr(i, num))(sth.Name), sth.Cells(i + TitleR, TitleC).Resize(1, TitleColNum))如果已经存在的话，就是说当我们运行到第4行的时候，这个时候zd（一班）已经存在了，并且zd(一班）（表1）也是存在的，这个时候他的数据区域呢？就不仅仅是当前的Cells(i + TitleR, TitleC)所在的哪一行了，因为之前已经有了第三行的数据了，所以这里要用union，就是将单元格结合的意思
那么得到的就是当前的区域加上之前的区域
然后继续往下呢？
最终的效果就是每个工作表对应的班级的数据区都被汇总到了对应的字典中，字典的格式是zd(班级）(工作表）
这样循环完所有的工作表之后，我们就已经成功的在字典中存储了整个工作表中的数据了，现在我们要做的就是拆分了，怎么拆呢？我们是按照班级来拆分的，自然就是按照大字典zd(班级）来进行拆分
循环每一个字典的键的内容，就是循环每一个班级的值，然后我们就可以创建对应的工作薄了，工作薄里面应该有4个工作表的，并且和我们创建的zd(班级）(工作表）的数据是一致的，那么这个如何实现呢？循环吗？
不，我们这里为了方便，直接一次创建4个共组表
然后就可以按照顺序来循环zd(班级）(工作表）这个工作表的键，每个键就是工作表的名称
然后创建工作表，同事将对应工作表的值，赋值上去
With .Worksheets(k) .Name = items'重命名 rng.Copy .Cells(1, 1)'复制表头 zd(Item)(items).Copy .Cells(TitleR + 1, 1)'将键值对复制到当前工作表中 End With然后报错工作表并且关闭，释放内容，一个循环就完成了，其他的工作薄也是通过相同的方式来实现的。
ActiveWorkbook.SaveAs pathn & "\" & Item ActiveWorkbook.Close False============================
本节课的案例源码已经上传，需要的小伙伴后台私信“7-56-6”，希望大家多支持~~，多多关注 ~ ~
好了，明晚21:00,准时再见!
因为公众号没有留言功能（开的比较晚），所以建立一个线下微信群，主要为大家提供一个交流的平台，同时大家也可以提一些对公众号的意见和看法，大家一起学习，一起进步。
联系客服
