1、打开带表头的数据，选择工具栏上面的“开发工具”，进入开发工具界面，就可以进行VB代码的操作了。
2、选择里面的visual basic ，点击进入visual basic 界面，就可以进行行代码的操作。
3、选择visual basic主界面中的“插入”工具选择下拉菜单中的“模板”，进入VB代码主界面。
4、将下面的代码输入“模板”的主界面。Sub learningexcel()Dim Arr, Rng As Range, Sht As Worksheet, Dic 帆歌达缒As ObjectDim k, t, Str As String, i As Long, lc As LongApplication.ScreenUpdating = False '关闭屏幕更新Arr = Range("A1").CurrentRegion.Valuelc = UBound(Arr, 2) '求取最后一列的列号Set Rng = Rows(1) '标题行Set Dic = CreateObject("Scripting.Dictionary") '创建字典For i = 2 To UBound(Arr)Str = Arr(i, 3) '关键字，如果要换列，改这个数字即可If Not Dic.Exists(Str) Then '如果字典没有关键字Set Dic(Str) = Cells(i, 1).Resize(, lc) '把当前行装入到字典中Else '否则(字典中存在关键字)Set Dic(Str) = Union(Dic(Str), Cells(i, 1).Resize(, lc)) '把行连合起来End IfNextk = Dic.Keys '字典关键字集合t = Dic.Items '字典项目集合On Error Resume NextWith SheetsFor i = 0 To Dic.Count - 1 '循环关键字的个数Set Sht = .Item(k(i)) '给变量赋值(工作表名为关键字)If Sht Is Nothing Then '该工作表不存在则插入一个空工作表.Add(After:=.Item(.Count)).Name = k(i) '新建的工作表将置于所有工作表之后，并命名为关键字Set Sht = ActiveSheet '活动工作表给变量Else '否则Sht.Cells.Clear '清除工作中所有内容和格式End IfRng.Copy Sht.Range("A1") '把标题写入第一行t(i).Copy Sht.Range("A2") '写入其他内容Sht.Cells.EntireColumn.AutoFit '自动调整全工作表单元格的列宽Set Sht = Nothing '变量处于初始状态NextEnd WithSheets(1).Activate '第1个工作表处于激活状态Application.ScreenUpdating = True '打开屏幕更新End Sub
5、点击主菜单上的快捷运行按钮，等待VB代码运行完成，就可以看到运行的结果了。
6、然后点击visual basic，主菜单上的关闭按钮，就visual basi罕铞泱殳c主界面关闭了，回到execl主界面，就可以看到拆分出来的表格了，点击保存既可。
