【原】Excel VBA 7.58以多列为标准拆分工作表，期待已久的多条件拆分来啦

Excel和VBA 2021-04-15

展开全文

之前我们拆分工作表的时候，都是按照单条件来进行拆分的，比方说某列为标准进行拆分，或者按照某个固定的条件来进行拆分，这样的拆分虽然是我们日常工作中比较常用的拆分方式，但是也有一定的局限性，那就是如果碰到需要满足多个条件的时候，上面的我们将书的方式可能就没有办法实行了，准确来说并不是没有办法实行，而是不能直接套用，需要稍微做下修改，今天我们就选取其中一个案例，大家呼声比较高的多列为标准进行拆分来分析下如何和之前已经学习过的单列拆分综合起来使用

场景说明

我们还是那之前已经被我们玩坏的案例

这是我们之前的案例，这里稍微坐下修改，我们将班级和年级进行拆分，分成年级一列班级一列的样子，我们现在的要求是按照班级列和年级列这两列来进行拆分，只有这两列的数据完全相同的情况下才可以分到一个新的工作表中，任何一列的数据不同都不能够分到一个工作表中，比方说高一1班和高一6班，虽然都是高一，但是班级不同，也不能分到一个工作表中，只有班级和年级两列都相同才可以，那么来看看代码

代码区

Sub TEST()Dim rng As Range, arr(), sth As WorksheetSet sth = ActiveSheetSet rng = Application.InputBox("拆分李", "拆分列", , , , , , 8)ColCount = Cells(2, Columns.Count).End(xlToLeft).ColumnRowCount = Cells(Rows.Count, 1).End(xlUp).Rowj = 0For i = 1 To rng.Rows.Count j = j + 1 ReDim Preserve arr(1 To 1, 1 To j) arr(1, j) = Cells(i + 2, 2) & "-" & Cells(i + 2, 3)Next iCells(2, ColCount + 1) = "辅助列"Cells(3, ColCount + 1).Resize(UBound(arr, 2), 1) = WorksheetFunction.Transpose(arr)Set rng = Range(Cells(2, ColCount + 1), Cells(RowCount, ColCount + 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) sth.Activate Rows(2).AutoFilter Field:=ColCount + 1, Criteria1:="=" & arr(i, 1) & "" With ActiveSheet.UsedRange .SpecialCells(xlCellTypeVisible).Copy sthn.Cells(1, 1) sthn.Columns(ColCount + 1).Delete End WithNext iRows(2).AutoFilterColumns(ColCount + 1).DeleteEnd Sub

看着代码很长，其实如果理解就会发现其实非常简单，本节基本上都是套用之前我们学习过的单列拆分工作表的代码来实现的Excel VBA 7.48工作表按照任意指定列进行拆分，给我一个标准我就能拆，之前我们是单列，现在是多列，怎么借用之前的代码呢？构造一个辅助列就可以了。

先看看代码执行的效果

说先确定拆分列，然后就可以等待结果了。

很明显已经顺利的完成了拆分，并且我们之前强调的高一1班和高一6班也是被当做了不同的班级，其他的也是顺利的实现了效果，验证下吧

成功的实现了我们的需求

代码分析

一起来分析下今天的代码

最开始的时候，我们也是交代了我们今天的方法的核心，就是构造一个辅助列，那么构造辅助列呢？既然我们已经有了拆分的标准列的范围了，那么我们就可以通过循环的方式，将我们选择的标准列的组合在一起，形成一个新的数据列

j = 0For i = 1 To rng.Rows.Count j = j + 1 ReDim Preserve arr(1 To 1, 1 To j) arr(1, j) = Cells(i + 2, 2) & "-" & Cells(i + 2, 3)Next i

看看最终执行的效果

这时候我们的数组刚好就是两列数据通过连字符“-”组合在一起的效果，那么我们就有了一个标准的拆分列，我们就按照这个拆分标准来进行拆分，我们将数据的表头增加一个字段，叫做辅助列，并且将我们的辅助数据添加到工作表中

Cells(2, ColCount + 1) = "辅助列"Cells(3, ColCount + 1).Resize(UBound(arr, 2), 1) = WorksheetFunction.Transpose(arr)

辅助列已经进入到了工作表中，然后我们就可以直接套用我们之前用单列拆分的方法了，获取数据的唯一值之后，直接在最后一列进行筛选并且得到我们想要的数据，并且复制出去到新的工作表中

当然因为辅助列并不是我们的原始数据源，所以在最后我们需要将我们构造的辅助列全部删除，以免影像数据的完整性

Columns(ColCount + 1).Delete

今天的代码肯定不是最简单的方法，相信网络中肯定会有很多更加简短的代码，我之所在这里通过这个非常LOW的方式来实现这个效果，主要就是告诉大家前后知识点的融会贯通，条条大路通罗马，没有最好的代码，只有最适合自己的代码，能够理解代码并且利用各种代码组合出自己想要的代码并且实现效果，那个你写的代码就是最好的！

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

本节课的案例源码已经上传，需要的小伙伴后台私信“7-58-s6”，希望大家多支持~~，多多关注 ~ ~

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

因为公众号没有留言功能（开的比较晚），所以建立一个线下微信群，主要为大家提供一个交流的平台，同时大家也可以提一些对公众号的意见和看法，大家一起学习，一起进步。