求VBA 生成成绩通知单

cqz2022 · 发表于 2023-4-27 16:58

有这样一个数据表，求利用VBA生成成绩通知单。
在新的工作表生成，新表名为【通知单+当前日期】，每个学生之前插入一个空白行，做了部分例子在文件中，谢谢。

小管家 - 副本.rar (25.39 KB, 下载次数: 32)

盼盼198310 · 发表于 2023-4-27 17:03

本帖最后由盼盼198310 于 2023-4-27 17:09 编辑

.............

yuyubiao · 发表于 2023-4-27 17:29

本帖最后由 yuyubiao 于 2023-4-28 11:22 编辑

Sub GenerateNotification()
'定义变量
Dim wb As Workbook
Dim wsSrc As Worksheet
Dim wsDest As Worksheet
Dim srcRowCount As Long, colCount As Long
Dim destRowCount As Long, i As Long, j As Long
Dim currentDate As String
'获取当前日期
currentDate = Format(Now(), "yyyymmdd")
'打开工作簿和原始数据表格
Set wb = ThisWorkbook
Set wsSrc = wb.ActiveSheet
'新建通知单工作表
Set wsDest = wb.Sheets.Add(after:=wsSrc)
wsDest.Name = "通知单" & currentDate
'获取行数和列数
srcRowCount = wsSrc.Cells(Rows.Count, 1).End(xlUp).Row
colCount = wsSrc.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To srcRowCount
wsSrc.Range("A1", wsSrc.Cells(1, colCount)).Copy wsDest.Cells(destRowCount + 1, 1)
wsSrc.Range(wsSrc.Cells(i, 1), wsSrc.Cells(i, colCount)).Copy wsDest.Cells(destRowCount + 2, 1)
destRowCount = destRowCount + 2
wsDest.Rows(destRowCount + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
destRowCount = destRowCount + 1
Next i
'删除最后插入的空白行
wsDest.Rows(destRowCount + 1).Delete
End Sub

复制代码

xiaoshai0401 · 发表于 2023-4-27 17:32

请测试。。。。。

cqz2022 · 发表于 2023-4-27 17:37

盼盼198310 发表于 2023-4-27 17:03
.............

谢谢
但我这里报错

想用【通知单4.27】这种日期格式可以吗

拜托帮忙调整一下

盼盼198310 · 发表于 2023-4-27 18:08

cqz2022 发表于 2023-4-27 17:37
谢谢
但我这里报错

...........

gwjkkkkk · 发表于 2023-4-27 19:32

请参考附件。。。

cqz2022 · 发表于 2023-4-27 22:16

yuyubiao 发表于 2023-4-27 17:29

辛苦了谢谢能不能实现只生成有“不合格”项的通知单，全都合格的不生成呢
谢谢

yuyubiao · 发表于 2023-4-27 23:18

cqz2022 发表于 2023-4-27 22:16
辛苦了谢谢能不能实现只生成有“不合格”项的通知单，全都合格的不生成呢
谢谢

可以的，明天帮你弄，不辛苦，上面这个代码是我用chatGPT生成的，然后修改的，不过下午赶着下班只是简单看到成果了就发出来了，实际感觉运行有点慢，我明天再看看

cqz2022 · 发表于 2023-4-28 06:36

yuyubiao 发表于 2023-4-27 23:18
可以的，明天帮你弄，不辛苦，上面这个代码是我用chatGPT生成的，然后修改的，不过下午赶着下班只是简单 ...

辛苦了万分感谢

		自动登录	找回密码
密码			免费注册