自动分成班级打印

eikok

自动分成班级打印.zip (18.8 KB, 下载次数: 20)

2023-2-27 13:23 上传

点击文件名下载附件

杨建营

eikok 发表于 2023-3-3 10:58

添加了一个条件，可以提取全部数据。请楼主参考。

半百

eikok

半百 发表于 2023-2-27 14:44

杨建营

楼主试试这样可以吗？

eikok

杨建营 发表于 2023-2-27 19:01
楼主试试这样可以吗？

杨建营

eikok 发表于 2023-2-27 19:32

根据上楼老师，修改了一些代码，运行正常。请楼主测试。

eikok

杨建营 发表于 2023-2-27 21:04
根据上楼老师，修改了一些代码，运行正常。请楼主测试。

代码可运行就是20班少一个人，求教.zip (59.09 KB, 下载次数: 12)

2023-3-3 10:58 上传

点击文件名下载附件

eikok

Sub SplitStudentsByClass()
    Dim currentRow As Integer
    currentRow = 2
    Dim currentClass As String
    currentClass = Mid(Range("A" & currentRow).Value, 5, 2)

    ' 创建第一个工作表
    Dim currentSheet As Worksheet
    Set currentSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
    currentSheet.Name = "班级 " & currentClass

    ' 复制表头
    Range("A1:B1").Copy currentSheet.Range("A1:B1")

    ' 复制学生信息
    Dim i As Integer
    For i = 2 To Range("A1").End(xlDown).Row
        If Mid(Range("A" & i).Value, 5, 2) <> currentClass Then
            ' 切换到下一个班级
            currentClass = Mid(Range("A" & i).Value, 5, 2)
            Set currentSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
            currentSheet.Name = "班级 " & currentClass
            Range("A1:B1").Copy currentSheet.Range("A1:B1")
            currentRow = 2
        End If

        Range("A" & i & ":B" & i).Copy currentSheet.Range("A" & currentRow & ":B" & currentRow)
        currentRow = currentRow + 1
    Next i
End Sub