分类汇总（按班级，可手动设置分类项）

分类汇总VBA源代码，可手动设置分类项，并将结果按分类项（班级）新建表格。

'按班级新建表Function NewTableByColumn()    On Error Resume Next    Dim tableName As String, colIndex As String '分类所在列    Dim startRowNumber  As Integer  '开始行    startRowNumber = 2: colIndex = "A"    Dim sh As Worksheet: Set sh = ThisWorkbook.Sheets(1)    Dim rng As Range, Rang As Range '班级区域    Set Rang = Null: Set rng = Null    For r = startRowNumber To sh.UsedRange.Rows.Count        tableName = sh.Cells(r, colIndex) '        If sh.Cells(r, colIndex) = sh.Cells(r - 1, colIndex) Then '属于同一个班级            Set rng = sh.Cells(r, colIndex).EntireRow            Set Rang = Union(Rang, rng)        Else '下一个班级，新建班级，新建班级之前将上一个班级的全部数据复制到对应的班级表中            With Rang                .Copy Destination:=ThisWorkbook.Worksheets(Worksheets.Count).[a2].Resize(.Rows.Count, .Columns.Count)            End With            If Not IsTableExist(tableName) Then                addTable (tableName)            End If            Set Rang = Null: Set Rang = sh.Cells(r, colIndex).EntireRow        End If    Next r    With Rang    '最后一个班级，复制到对应的班级表中        .Copy Destination:=ThisWorkbook.Worksheets(Worksheets.Count).[a2].Resize(.Rows.Count, .Columns.Count)    End WithEnd FunctionFunction addTable(tableName As String)    Dim sh As Worksheet    Set sh = ThisWorkbook.Sheets(1)    Worksheets.Add after:=Worksheets(Worksheets.Count)    Dim sht As Worksheet    Set sht = ThisWorkbook.Sheets.Item(Worksheets.Count)    With sht        .Name = tableName        sh.Rows(1).Copy Destination:=.[a1].Resize(1, sh.UsedRange.Columns.Count)    End WithEnd FunctionFunction IsTableExist(tableName As String) As Boolean    On Error Resume Next    If Sheets(tableName) Is Nothing Then        IsTableExist = False    Else        IsTableExist = True    End IfEnd Function

待分类汇总的总表：

分类汇总后新建的表：