生成准考证时，语句出错，

hlwulin

生成准考证时，语句出错，麻烦各位帮帮忙！谢谢

abc123281

路过而已  没事写个玩玩  仅供参考

Sub 生成准考证()
Dim arr, brr
Dim rng As Range
Application.ScreenUpdating = False
brr = Split("b3 d3 b4 d4 b5 d5 b6 d6 b7 d7 b8 d8 b9 ")
Set ws = Worksheets("准考证")
ws.Cells.Clear
With Worksheets("数据表")
  r = .[b65536].End(xlUp).Row
  arr = .Range("a2:m" & r)
End With
r = 1
c = 1
With Worksheets("模板")
  For i = 1 To UBound(arr)
    For j = 1 To UBound(arr, 2)
      .Range(brr(j - 1)) = arr(i, j)
    Next
    Set rng = .Range("a1").Resize(10, 4)
    rng.Copy ws.Cells(r, c)
    c = c + 5
    If c > 10 Then
      r = r + 11
      c = 1
    End If
  Next
End With
Application.ScreenUpdating = True
MsgBox "OK", 64
End Sub

abc123281

生成准考证abc123.rar (20.42 KB, 下载次数: 21)

2019-6-20 13:48 上传

点击文件名下载附件

xiangbaoan

向楼上楼下老师学习！
Private Sub CommandButton5_Click()'也补一个 17:28
Dim a, ar, i%, j%, rng As Range, sh As Worksheet, r&, c%
Application.ScreenUpdating = False
a = Split("班别 姓名 四科考场 四科座号 化学考场 化学座号 生物考场 生物座号 政治考场 政治座号 地理考场 地理座号 准考证号")
Set rng = Worksheets("板模").[a1].Resize(10, 4)
Set sh = Worksheets("准考证")
sh.Cells.Clear
ar = Worksheets("数据表").[a1].CurrentRegion.Resize(, 13)
For i = 2 To UBound(ar)
    c = 1 + (i Mod 2) * 5
    r = 1 + 12 * Int((i - 2) / 2)
    For j = 1 To UBound(ar, 2)
        rng.Find(a(j - 1), , , 1).Offset(0, 1) = ar(i, j)
    Next
    rng.Copy sh.Cells(r, c)
Next
a = Array(12, 10, 12, 10, 4, 12, 10, 12, 10)
For j = 0 To UBound(a)
    sh.Columns(j + 1).ColumnWidth = a(j)
Next
Application.ScreenUpdating = True
Unload Me
End Sub

YZC51

向老师学习下。谢谢老师！
生成准考证abc123.rar (25.32 KB, 下载次数: 23)

2019-6-20 16:54 上传

点击文件名下载附件

YZC51

xiangbaoan 发表于 2019-6-20 15:03
向楼上楼下老师学习！
Private Sub CommandButton5_Click()'也补一个 17:28
Dim a, ar, i%, j%, rng As R ...

高！增加了列宽控制！！！
鲜花明天补上！

xiangbaoan

YZC51 发表于 2019-6-20 19:14
高！增加了列宽控制！！！
鲜花明天补上！

向YZC51老师学习、致敬！

hlwulin

还是有问题

hlwulin

YZC51 发表于 2019-6-20 19:14
高！增加了列宽控制！！！
鲜花明天补上！

还是有问题

YZC51

xiangbaoan 发表于 2019-6-20 19:36
向YZC51老师学习、致敬！

老师您过谦！！！