表格中有空行无法筛选！只能手动复制拆分？VBA我能拆

前景提要

之前我们分享了一些简单的工作表数据的拆分，之所以说是比较的简单，因为工作表的数据比较的标准，并没有太复杂的结构，也并不需要做出太多的判断，所以我觉得还是属于简单的工作表拆分，不过这样的工作表拆分，已经没有办法满足大家工作的需要了，毕竟日常工作中怎么可能会有这么标准的数据，之前就有小伙伴提供过一个案例，就是和我们昨天的内容差不多，但是也有一点不同，单元格中空行，常规的筛选都不可能实现，想要筛选似乎很难，我们来看看案例

场景说明

我们来看看我们的数据源

在进行数据统计的过程中，为了方便区分，所以每个班级的数据中间都是间隔了一个空行，这也是很多小伙伴们日常坐标常规操作吧，看起来是很清晰，但是数据处理则是非常的麻烦，筛选？不可能的

智能筛选到其中的很小一部分，那么在这样的情况下，我们要如何进行数据拆分呢？来，和我一起来尝试下吧

代码区

Sub chai()Dim rng As Range, sth As Worksheet, sthn As Worksheet, Trng As Range, firstR As RangeSet sth = ActiveSheetSet rng = Application.InputBox("请选择表头区域", "表头区域的确定", , , , , , 8)TitleR = rng.Rows.CountTitleC = rng.ColumnTitleColNum = rng.Columns.CountTargetRowNum = InputBox("请输入拆分标准列的列数")TargetRowNum = Int(TargetRowNum)l = Cells(Rows.Count, TargetRowNum).End(xlUp).RowSet firstR = Cells(TitleR + 1, TargetRowNum)k = 0For i = TitleR + 2 To l If firstR <> "" And i <> l Then k = k + 1 If Cells(i, TargetRowNum) <> firstR Then Worksheets.Add after:=Worksheets(Worksheets.Count) Set sthn = ActiveSheet sthn.Name = firstR rng.Copy sthn.Cells(1, 1) sth.Activate sth.Range(Cells(i - k, TitleC), Cells(i - 1, TitleColNum + TitleC)).Copy sthn.Cells(TitleR + 1, 1) k = 0 Set firstR = Cells(i, TargetRowNum) End If Else If i <> l Then Set firstR = firstR.Offset(1, 0) Else k = k + 1 Worksheets.Add after:=Worksheets(Worksheets.Count) Set sthn = ActiveSheet sthn.Name = firstR rng.Copy sthn.Cells(1, 1) sth.Activate sth.Range(Cells(i - k, TitleC), Cells(i, TitleColNum + TitleC-1)).Copy sthn.Cells(TitleR + 1, 1) End If End IfNext iEnd Sub

好吧，我也觉得今天的代码有点长了。先来看看这个代码执行的效果

这里有一点变化，这里需要输入的是拆分的标准列，这里标准列其实应该是依据列比较合适，这份表我们现在要按照班级来进行拆分，这里我们不手动选择，因为有空行，我们要选择区域的话，不太好选择，这里我们换成直接手动输入列数，这里我们按照班级来进行拆分，所以直接输入第3列

然后就可以出结果了。

已经完成了班级的拆分，随便抽一个来看看结果

搞定

代码分析

看看代码

Set rng = Application.InputBox("请选择表头区域", "表头区域的确定", , , , , , 8)TitleR = rng.Rows.CountTitleC = rng.ColumnTitleColNum = rng.Columns.CountTargetRowNum = InputBox("请输入拆分标准列的列数")TargetRowNum = Int(TargetRowNum)

这一大段应该都是基础知识了，主要是实现表头的确认以及inputbox输入框的利用，很简单的

今天的重点和难点就是要找到一个合理的判断方式，因为班级是从上往下是完全一致的，仅仅是空格隔开了，所以我们只需要循环班级列，如果碰到了单元格内容不等于上面一个内容的就是，就证明完成了一个班级，就可以将这部分的数据复制过去了，

真的是这样的嘛？不对，因为如果这样执行的话，我们忽略了表格中最大的一个BUG，空格，如果是空格，我们还要做出进一步的判断，来看其中一部分代码

For i = TitleR + 2 To l k = k + 1 If Cells(i, TargetRowNum) <> firstR Then Worksheets.Add after:=Worksheets(Worksheets.Count) Set sthn = ActiveSheet sthn.Name = firstR rng.Copy sthn.Cells(1, 1) sth.Activate sth.Range(Cells(i - k, TitleC), Cells(i - 1, TitleColNum + TitleC)).Copy sthn.Cells(TitleR + 1, 1) k = 0 Set firstR = Cells(i, TargetRowNum) End If Else Set firstR = firstR.Offset(1, 0) End Ifnext i

我们先忽略i和l之间的判断，来研究其中的一部分代码

这里就是判断单元格的内容和之前的单元格不同的时候的操作，这里我们需要涉及对于空格的判断

进入第一个小判断，这时候已经是来到了空格区域了

当我们将上面的这一段常规数据复制到新建表格之后，我们还是要将初始单元格firstR进行重新定义，这时候我们定义为现在i所指向的单元格，也是是空格，空格是没有办法进行判断的，所以当我们再次进行循环判断的时候，我们要在前面加一个句

If firstR <> "" then

这样就可以规避单元格为空的情况，如果单元格为空，则将下一个单元格定义为新的firstR，

可能这里有小伙伴们会说，为什么不直接将下一行作为firstR呢？这样不是更方便嘛？这里就牵涉到一个通用性的问题，如果其他的数据表，中间的间隔行不是1行，是2行，或则跟多行呢？所以这里还是通过判断的方式比较好

这样就结束了嘛？

没有

和我们上面的完整代码还有一大段的差距，差距在哪里呢？

末尾是否到达最后一行的判断

当然上面的方法并不是唯一也不是最简单的方法，不过我还是希望大家能够理解者方法的思路和代码执行的过程，这对于大家独立分析这种情况有很大的帮助，