按班级名称拆分为多个工作表

楼主杨开科	示例文件见：按班级名称拆分为多个工作表.rar Option Explicit '按班级名称拆分为多个工作表 '着重知识点：数组、字典、ADO '知识在于积累 Sub Split_Sheet() '声明变量 Dim ed As Long, ar(), d As Object, i As Long Dim cn As Object, rs As Object, k() Dim ws As Worksheet, sql As String, iCols As Integer Application.ScreenUpdating = False ' 关闭屏幕更新 With Sheets("学生名单") ed = .Range("A" & Rows.Count).End(xlUp).Row ' 将学生名单表中A列数据区域最大行数赋值给变量ed ar = .Range("A2:A" & ed).Value '赋值给数组，从A2开始的原因是A1是表格标题 End With Set d = CreateObject("Scripting.Dictionary") '字典对象引用赋值，后期绑定 For i = 1 To ed - 1 '建立一个循环 d(ar(i, 1)) = 0 '赋值为"0"不具实际意义，只起个将学生名单表中班级名称去重复，加入字典的作用。将它改成=1、=""、="什么"都行 Next i Set cn = CreateObject("ADODB.Connection") ' 创建ADO连接，将 CreateObject 返回的对象赋给对象变量cn cn.Open "provider=Microsoft.Jet.OLEDB.4.0;extended properties='Excel 8.0;hdr=Yes;IMEX=1';data source=" & ThisWorkbook.FullName ' 打开连接到本工作簿 ' cn.Open "provider=Microsoft.ACE.OLEDB.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.FullName k = d.keys '把字典中存在的所有的关键字赋给变量k,得到的是一个一维数组 For i = 0 To d.Count - 1 ' 字典键值数组循环 Set ws = Worksheets.Add ' 新建工作表 With ws '班级名称是一个文本字符串，要加双引号，'" & k(i) & "'，双引号加在单引号中间 sql = "Select * From [学生名单$] Where 班级名称='" & k(i) & " '" Debug.Print sql '按ctrl+G打开“立即窗口”，可查看每条sql Set rs = cn.Execute(sql) '执行查询操作赋值给对象变量rs For iCols = 0 To rs.Fields.Count - 1 '为取字段名为新工作表添加表格标题 .Cells(1, iCols + 1).Value = rs.Fields(iCols).Name Next .[A2].CopyFromRecordset rs ' 自新工作表A2单元格复制查询结果 .Cells.EntireColumn.AutoFit '自动调整列宽 .Name = k(i) '将新工作表重命名为班级名称 End With Next i '执行下一次循环，直到 i = d.Count - 1 cn.Close '关闭连接 '释放对象变量 Set d = Nothing Set cn = Nothing Set ws = Nothing Application.ScreenUpdating = True '启用屏幕更新 MsgBox "数据拆分完成！", 64, "提示" End Sub
2楼水星钓鱼	异曲同工
3楼 meteorak	能否在输出学生名单前按一定的顺序再排列一次再输出呢？比如按姓名顺序，总分顺序等在33. Debug.Print sql '按ctrl+G打开“立即窗口”，可查看每条sql 34. Set rs = cn.Execute(sql) '执行查询操作赋值给对象变量rs 之后加什么代码可以排列呢？
4楼 bluexuemei	在SQL语句后面加排序语句,order by 字段
5楼 xinya	有注解，太好了，正苦于无法理解这些代码的意思呢，感谢感谢