【原】Excel VBA 7.48工作表按照任意指定列进行拆分，给我一个标准我就能拆

一起学习，一起进步~~

今天我们正式开始分享一些关于工作表的拆分的一些知识，前面我们已经陆陆续续的学习了很多关于工作表的合并的操作，现在我们开始进入工作表的合并的对立面-工作表的拆分，将总表按照各种要求进行花式拆分，小伙伴们准备好了，准备开车了

今天我们来分享下如何按照指定列进行拆分工作表

场景说明

假设我们现在有一个工作表，是所有的班级的学生的考试成绩的汇总表，我们现在希望按照班级来进行分析，分析每个班级的最高分和平均分，从而针对不同的班级进行有针对性的指导

从上面的信息中，我们得到了我们需要按照班级这一列来进行拆分，所以我们拆分的参照列就是班级这一列了，如果让你手工操作你会怎么操作呢？先进性筛选，然后按照每个班级选项进行新建工作表，复制粘贴，如此循环

代码区

先来看看代码

Sub chai()Dim rng As Range, trng As Range, arr, sthn As WorksheetSet trng = Application.InputBox("请选择标题栏", "标题栏的确定", , , , , , 8)TitleR = trng.Rows.CountTitleC = trng.ColumnSet rng = Application.InputBox("请选择要拆分的参照列", "参照列的确定", , , , , , 8)num = ActiveSheet.IndexTargetCol = rng.Column - (TitleC - 1)Worksheets.Add after:=Worksheets(Worksheets.Count)rng.Copy Cells(1, 1)With ActiveSheet.UsedRange .RemoveDuplicates 1, xlNoEnd Withl = Cells(Rows.Count, 1).End(xlUp).RowSet rng = Range(Cells(2, 1), Cells(l, 1))arr = rngApplication.DisplayAlerts = FalseActiveSheet.DeleteApplication.DisplayAlerts = TrueFor i = 1 To UBound(arr) Worksheets.Add after:=Worksheets(Worksheets.Count) Set sthn = ActiveSheet ActiveSheet.Name = arr(i, 1) Worksheets(num).Activate Rows(TitleR).AutoFilter Field:=TargetCol, Criteria1:="=" & arr(i, 1) & "" With ActiveSheet.UsedRange .SpecialCells(xlCellTypeVisible).Copy sthn.Cells(1, 1) End WithNext iEnd Sub

先来看看代码执行的过程

首先先要我们选择标题栏，为什么要在这里选择标题栏呢？

因为我们不确定我们的标题栏有几行，如果是单行标题最好，直接从第一行开始筛选，但是像我们案例中这样的有多行表头的，就不行了，所以我们要选确定标头的区域

然后我们立刻得到标题行总共有多少行，这个方法我们前面已经讲过很多次了。 

然后就需要我们确定拆分的参照列了，我们前面已经说过了是按照班级分析，自然就是按照班级来进行拆分了，所以这里选择班级列

然后稍等一会结果就出来了，所有数据按照班级成功的拆分完毕

每个班次的数据也是完全正确的

代码分析

我们现在来看看代码

Set trng = Application.InputBox("请选择标题栏", "标题栏的确定", , , , , , 8)TitleR = trng.Rows.CountTitleC = trng.ColumnSet rng = Application.InputBox("请选择要拆分的参照列", "参照列的确定", , , , , , 8)

这几段代码大家都非常的熟悉了，只要是选择工作表的区域，然后确定行数，列数的，这里就不在详细说明了。 

rng.Copy Cells(1, 1)With ActiveSheet.UsedRange .RemoveDuplicates 1, xlNoEnd With

我们将班级这一列的数据全部复制过来，然后进行去重。

RemoveDuplicates就是单元格之间进行去重操作的方法，大家一定要记住，在后续的工作中，这个方法会经常使用到，他能够保留单元格数据的唯一值，这样我们不用在通过条件格式来找出重复想在删除了。 

当然这一切都是在另外一个工作表中完成的， 算是一个辅助的工作表，当我们得到了唯一的班级序列之后，这个工作表就没有价值了，可以直接删除了。

Application.DisplayAlerts = FalseActiveSheet.DeleteApplication.DisplayAlerts = True

Application.DisplayAlerts 是设置弹窗告警是否出现的false就是不出现，当我们删除工作表的时候，都会有一个提示窗口

如果不想要就设置false就可以，他对于我们代码的正常执行有很大的影响，所以一般都会关掉，在完成删除之后再打开

For i = 1 To UBound(arr) Worksheets.Add after:=Worksheets(Worksheets.Count) Set sthn = ActiveSheet ActiveSheet.Name = arr(i, 1) Worksheets(num).Activate Rows(TitleR).AutoFilter Field:=TargetCol, Criteria1:="=" & arr(i, 1) & "" With ActiveSheet.UsedRange .SpecialCells(xlCellTypeVisible).Copy sthn.Cells(1, 1) End WithNext i

这段代码就是执行数据的筛选以及筛选之后的数据的复制粘贴的，属于固定的套路格式，大家记下来直接使用就好。

================================

好了，明晚21:00,准时再见!