按模板批量生成绩登记表

hjd528

请老师VBA帮忙弄一下，谢谢！


1. 将报名表中的准考证号和姓名按顺序批量填入模板中，每24人为一张表，将所有的登记表放在一张工作表中；
2. 需要的效果在“打印”表中，格式要保留模板的格式。




按模板批量生成绩登记表.rar (23.44 KB, 下载次数: 27)

2024-1-6 15:03 上传

点击文件名下载附件

wang-way

wang-way

hjd528

wang-way 发表于 2024-1-6 15:48

非常感谢！注释详细。还有两个需求能帮一下：①打印表中的列宽和行高按模板的保持一致，②每18行插入分页符

3190496160

Sub 批量生成()
Application.ScreenUpdating = False
With Sheets("报名表")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 2 Then MsgBox "报名表为空！": End
    ar = .Range("a2:d" & r)
End With
hs = UBound(ar) - 1
If hs / 24 = Int(hs / 24) Then
    gs = hs / 24
Else
    gs = Int(hs / 24) + 1
End If
With Sheets("模板")
    .Range("b6:f17") = Empty
    .Range("h6:l17") = Empty
    rs = .Cells(Rows.Count, 1).End(xlUp).Row
    If rs > 18 Then .Rows("19:" & rs).Delete
    m = 19
    For i = 2 To gs
        .Rows("1:18").Copy .Cells(m, 1)
        m = m + 18
    Next i
    m = 5
    For i = 2 To UBound(ar) Step 24
        xh = m
        For s = i To i + 11 Step 1
            If s <= UBound(ar) Then
                xh = xh + 1
                .Cells(xh, 2) = ar(s, 2)
                .Cells(xh, 3) = ar(s, 3)
            End If
        Next s
        xh = m
        For s = i + 12 To i + 23 Step 1
            If s <= UBound(ar) Then
                xh = xh + 1
                .Cells(xh, 8) = ar(s, 2)
                .Cells(xh, 9) = ar(s, 3)
            End If
        Next s
        m = m + 18
    Next i
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

直接在模板中生成即可
按模板批量生成绩登记表.rar (30.38 KB, 下载次数: 61)

2024-1-7 09:03 上传

点击文件名下载附件

hjd528

3190496160 发表于 2024-1-7 09:03
直接在模板中生成即可

太感谢了！也很好用！但行高不宜设得过高，还得要插入分页符比较好。老师能否加入分页符的代码？

hjd528

再次感谢上面两位老师的帮助！
分页符、行高、列宽已设置好，目前设置行高设置为所有行高为40，但实际需求是：每张表的第1行设置为48，第2--5行为设置30，第6--18行设置为40，还是没法实现这样需求。哪位大神帮忙修改一下代码。谢谢。
按模板批量生成绩登记表.rar (28.04 KB, 下载次数: 16)

2024-1-7 11:37 上传

点击文件名下载附件

sunshuangzhong

可以录制格式刷刷一下呀

gwjkkkkk

hjd528 发表于 2024-1-7 11:40
再次感谢上面两位老师的帮助！
分页符、行高、列宽已设置好，目前设置行高设置为所有行高为40，但实际需求 ...

请参考附件。。。