1、需求：
根据某一列内容，将1个Sheet表格拆分为多个分表。
2、举例：
还是接着上一次的例子，分年龄段统计人数工作完成后，你又接到任务需要将总表根据年龄段拆分为多个分表。
因为例子里只有5个年龄段，所以你完全可以筛选复制5次就搞定了，不过，如果后面又有变化，比如需要根据职务或者其他情况来拆分，那你又得手动去处理了，让我们看看用VBA代码如何来完成这个工作，一旦情况变化，你只要重新运行一次程序就可以。
3、代码实现
这个功能的实现原理其实和筛选也差不多，我们需要获取作为拆分表格列的不重复项目，然后得到每一个不重复项目的单元格，再复制单元格就可以了。
要获取不重复的项目，字典自然是最好的选择，我们使用字典对象来记录每一个关键字对应的所有单元格，最后将字典记录下来的单元格复制到新表即可：
Enum RetCode
ErrRT = -1
SuccRT = 1
End Enum
Enum Pos
RowStart = 2
年龄段 = 6
KeyCol = 年龄段
Cols = 年龄段
End Enum
Type DataStruct
Src() As Variant
Rows As Long
Cols As Long
Result() As Variant
End Type
Sub vba_main()
Dim d As DataStruct
If RetCode.ErrRT = ReadSrc(d) Then Exit Sub
If RetCode.ErrRT = GetResult(d) Then Exit Sub
End Sub
Private Function GetResult(d As DataStruct) As RetCode
Dim dic As Object
Set dic = VBA.CreateObject("Scripting.Dictionary")
Dim i As Long
Dim strkey As String
For i = Pos.RowStart To d.Rows
strkey = VBA.CStr(d.Src(i, Pos.KeyCol))
If dic.Exists(strkey) Then
'再次出现的关键字，合并
Set dic(strkey) = Excel.Union(Cells(i, 1).Resize(1, Pos.Cols), dic(strkey))
Else
'第一次出现的关键字，记录标题及当前行单元格
Set dic(strkey) = Excel.Union(Cells(1, 1).Resize(1, Pos.Cols), Cells(i, 1).Resize(1, Pos.Cols))
End If
Next
Dim keys As Variant
keys = dic.keys()
Dim items As Variant
items = dic.items()
'新建表并复制单元格
For i = 0 To UBound(keys)
strkey = VBA.CStr(keys(i))
'注：这里没有去考虑sheet的名称是否合规，sheet名称是不能包含" / 等字符的"
Worksheets.Add().Name = strkey
items(i).Copy Range("A1")
Next
End Function
Private Function ReadSrc(d As DataStruct) As RetCode
ReadSrc = ReadData(d.Src, d.Rows, Pos.Cols, Pos.KeyCol, Pos.RowStart)
End Function
Private Function ReadData(ByRef RetArr() As Variant, ByRef RetRow As Long, Cols As Long, KeyCol As Long, RowStart As Long) As RetCode
ActiveSheet.AutoFilterMode = False
RetRow = Cells(Cells.Rows.Count, KeyCol).End(xlUp).Row
If RetRow < RowStart Then
MsgBox "没有数据"
ReadData = RetCode.ErrRT
Exit Function
End If
RetArr = Cells(1, 1).Resize(RetRow, Cols).Value
ReadData = RetCode.SuccRT
End Function如果后面需求有变化，需要按别的列进行拆分，只要修改Pos枚举里的KeyCol即可。
