VBA生成标签代码修改

hbszls · 发表于 2019-9-27 16:14

请教各位熟悉VBA的高手，帮忙修改下代码。实现三栏的标签效果。谢谢！

xuemei0216 · 发表于 2019-9-27 16:33

看看，是不是你想要的效果

hbszls · 发表于 2019-9-27 16:57

谢谢了，很好的。有个地方，麻烦改下。需要的是姓名，你生成的是班级代码

专搞excel · 发表于 2019-9-27 17:21

hbszls 发表于 2019-9-27 16:57
谢谢了，很好的。有个地方，麻烦改下。需要的是姓名，你生成的是班级代码

找到代码.[b2].Offset(y - 1, x - 1) = arr(i, 1)，换为.[b2].Offset(y - 1, x - 1) = arr(i, 3)

YZC51 · 发表于 2019-9-28 12:17

hbszls 发表于 2019-9-27 16:57
谢谢了，很好的。有个地方，麻烦改下。需要的是姓名，你生成的是班级代码

请参考
Sub a()
Application.ScreenUpdating = False
Sheets(3).UsedRange.Clear                            '结果表，删除内容
Dim arr, m&, m1&, x&, y&, i&
arr = Sheets(1).[a1].CurrentRegion.Offset(2)          '数据源，不含标题
For i = 1 To UBound(arr) - 3 Step 3                   '粘贴次数
With Sheet2                                        '模板表
      .[c1] = arr(i, 2): .[G1] = arr(i + 1, 2): .[K1] = arr(i + 2, 2)
      .[c2] = arr(i, 3): .[G2] = arr(i + 1, 3): .[K2] = arr(i + 2, 3)
      r = Sheet3.Cells(Rows.Count, 2).End(3).Row + 3
      .Rows("1:4").Copy Sheet3.Cells(r, 1)          '粘贴模板表到结果表
End With
Next
Application.ScreenUpdating = True
MsgBox "生成完毕！"
End Sub

YZC51 · 发表于 2019-9-28 12:20

本帖最后由 YZC51 于 2019-9-28 12:24 编辑

代码审核中，上传附件

生成标签代码-.rar (31.14 KB, 下载次数: 12)

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

[求助] VBA生成标签代码修改

评分

评分

最新热点 /1