Excel VBA 7.57花花绿绿的工作表我也能拆， 按照颜色拆分工作表
一起学习，一起进步~~
今天我们继续来学习工作表的拆分，今天的拆分就有点独特了，对于一些比较追求工作表样式多样化的小伙伴来说就可能会比较常见这样的情况，我们今天是按照颜色来进行拆分的，是不是比较奇特，在进行数据登记或者一次统计录入的时候，为了方便大家可能会想尽办法通过各种比较简单的方式来实现数据的区分，比方说着色，着色确实是比较的方便，点下着色按钮就可以了，并且最终出来的报表还有一种五颜六色炫酷的效果，但是问题来了，这样的报表看着方便，但是后面数据处理的童鞋就不方便了，毫无规则的数据既不按列拆分，又不好按照区域拆分，按照颜色拆分？有这样的功能嘛？
场景说明
这是我们今天的数据源
这里我们的数据源统计的时候并不是按照班级或者其他的规则来区分的，只有一个颜色，可能使用者也是一个追求表格美化的童鞋，在第一次统计数据的时候，就选择了通过多彩的颜色来进行区分，乍一看还是挺好区分的，黄色一个区域，红色一个区域，非常的清晰明了，不过，这样的数据，你让后面进行数据统计的童鞋怎么办？一个拆分的标准都没有,颜色拆分似乎没有这个功能，那我们就自己创造一个这样的功能
代码区
Sub chai()Dim rng As Range, sth As Worksheet, sthn As Worksheet, crng As RangeSet sth = ActiveSheetSet rng = Application.InputBox("请选择表头区域", "表头区域的确定", , , , , , 8)TitleR = rng.Rows.CountTitleC = rng.ColumnTitleColNum = rng.Columns.CountSet crng = Application.InputBox("请选择拆分列标准列", "标准列的确定", , , , , , 8)num = crng.Columnl = Cells(Rows.Count, num).End(xlUp).RowSet crng = Cells(TitleR + 1, num)For i = TitleR + 2 To l + 1 If Cells(i, num).Interior.Color <> crng.Interior.Color Then Worksheets.Add after:=Worksheets(Worksheets.Count) Set sthn = ActiveSheet rng.Copy sthn.Cells(1, 1) sth.Activate sth.Range(crng, Cells(i - 1, TitleColNum + TitleR - 1)).Copy sthn.Cells(TitleR + 1, 1) sthn.Name = crng.Interior.Color Set crng = Cells(i, num) End IfNext iEnd Sub来，直接看过程
选择表头
选择拆分标准列
然后出结果
抽取一个工作表看看
数据完整，一个不拉
代码分析
Set rng = Application.InputBox("请选择表头区域", "表头区域的确定", , , , , , 8)TitleR = rng.Rows.CountTitleC = rng.ColumnTitleColNum = rng.Columns.CountSet crng = Application.InputBox("请选择拆分列标准列", "标准列的确定", , , , , , 8)num = crng.Columnl = Cells(Rows.Count, num).End(xlUp).Row这里依然是老规矩了，通过inputbox的方法来实现交互窗体得到我们实际想要的结果
然后进入今天的主题
Set crng = Cells(TitleR + 1, num)这个套路不知道大家是否已经熟悉了，在进行操作对比的过程中，我们可以选择一个固定的单元格进行对比操作，这样可以节省我们的代码量，同时也可以减少代码的逻辑判断
这里我们的crng指向的就是拆分列的第一个单元格
有了这个初始单元格之后，我们就可以进行循环比较了，如何比较，判断每个单元格的颜色是否等于初始单元格，颜色还能比较，没错
If Cells(i, num).Interior.Color <> crng.Interior.Color Then简单的一句话就轻松的实现了颜色的比较，cells.Interior.Color得到的就是单元格的背景色，这里重点强调一个，背景色，并不是字体的颜色之类的
一直循环到那个背景色不同的单元格之后，剩下的就是套路了。
Worksheets.Add after:=Worksheets(Worksheets.Count) Set sthn = ActiveSheet rng.Copy sthn.Cells(1, 1) sth.Activate sth.Range(crng, Cells(i - 1, TitleColNum + TitleR - 1)).Copy sthn.Cells(TitleR + 1, 1)新建工作表，复制数据区域
然后小细节要注意
Set crng = Cells(i, num)一定要记得初始化crng,否则你的crng永远都是指向第一个黄色的单元格区域，那么最终的数据不准确了。
这里有小伙伴会有疑问，为什么我们的工作表名称是一堆数字
这里我要解释下，在VBA中，他们判断颜色并不是和我们一样，他们返回的是一堆数字，数字代表的就是颜色，所以他们在判断的过程中，其实也是判断返回的数字是否相同而已，至于如何将这一串数字转化成为中文呢？
这个我觉得用处不大，就暂时没有研究过。我们只需要知道这里如何拆分既可以了，掌握这种方法才是最主要的。
另外说一点，不着色的区域也就是无色的区域，在按照颜色拆分的时候，他也会被识别为一种颜色，单独出来的，这点大家也要注意。
============================
本节课的案例源码已经上传，需要的小伙伴后台私信“7-56-31”，希望大家多支持~~，多多关注 ~ ~
好了，明晚21:00,准时再见!
因为公众号没有留言功能（开的比较晚），所以建立一个线下微信群，主要为大家提供一个交流的平台，同时大家也可以提一些对公众号的意见和看法，大家一起学习，一起进步。