根据名单生成标签

hbszls

感谢大家的帮助！需求效果见附件。

z865593849

按名单打印考场标签

longwin

longwin

Sub test()
arr = Sheets("名单").[a1].CurrentRegion
ReDim brr(1 To 1 + UBound(arr) / 2, 1 To 7)
For i = 2 To UBound(arr)
    zt = "班级：" & arr(i, 1) & "  姓名：" & arr(i, 2) & Chr(10) & "性别：" & arr(i, 3) & "  考号:" & arr(i, 4)
    hh = 1 + 2 * Int((i - 2) / 4)
    ll = 1 + 2 * ((i - 2) Mod 4)
    brr(hh, ll) = zt
Next
Sheets("需求效果").[a1].Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub

Qs18

1. Sub qs()
   
2. Dim arr, i
   
3. With Sheet1
   
4.     arr = .Range("a1").CurrentRegion.Value
   
5.     ReDim brr(1 To UBound(arr), 1 To 7)
   
6.         m = 1: cl = 1
   
7.     For i = 2 To UBound(arr)
   
8.         If cl > 8 Then
   
9.         cl = 1
   
10.         m = m + 2
    
11.         brr(m, cl) = arr(1, 1) & "：" & arr(i, 1) & "   " & arr(1, 2) & "：" & arr(i, 2) & "   " & arr(1, 3) & "：" & arr(i, 3) & "   " & arr(1, 4) & "：" & arr(i, 4)
    
12.         cl = cl + 2
    
13.         Else
    
14.         brr(m, cl) = arr(1, 1) & "：" & arr(i, 1) & "   " & arr(1, 2) & "：" & arr(i, 2) & "   " & arr(1, 3) & "：" & arr(i, 3) & "   " & arr(1, 4) & "：" & arr(i, 4)
    
15.         cl = cl + 2
    
16.         End If
    
17.     Next
    
18. End With
    
19. Sheet2.Range("a1").Resize(m, 7) = brr
    
20. End Sub
    

复制代码

Qs18

试试........

Qs18

试试.......

hbszls

z865593849 发表于 2024-11-12 10:35
按名单打印考场标签

谢谢！这个怎么设置空行的行距及列宽，方便调整打印。

翁知江安

这是运行结果

翁知江安

这是运行程序，供参考，欢迎批评指正