自动分成班级打印

eikok

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

2023-2-27 13:22 上传

点击文件名下载附件

rlz680926

添辅助列，MID取出相应班级，数据－－－分类汇总

eikok

rlz680926 发表于 2023-2-27 15:02
添辅助列，MID取出相应班级，数据－－－分类汇总

求vba代码

rlz680926

Sub test()
Application.DisplayAlerts = False
Dim sht As Worksheet
Range("a1:c1").Insert
Range("a1:c1") = Array("ѧoÅ", "DÕÃû", "°à¼¶")
Dim i As Integer
For i = 2 To Range("b65536").End(xlUp).Row
    Cells(i, 3) = --VBA.Mid(Cells(i, 1), 5, 2)
Next
Stop
For m = 1 To 20
Range("a:c").AutoFilter field:=3, Criteria1:=m
Set sht = Sheets.Add(after:=Sheets(Sheets.Count))
sht.Name = m
Sheets(1).Range("a1", Sheets(1).Range("b65536").End(xlUp)).Copy Sheets(Sheets.Count).Range("a1")
ActiveSheet.PrintOut Copies:=1
Sheets(Sheets.Count).Delete
Sheets(1).Range("a:c").AutoFilter
Next
Application.DisplayAlerts = True
End Sub