设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 1801|回复: 2
打印 上一主题 下一主题

请老师们给解释一下,下面的代码的含义,是一个关于使用标签模板的例子里面的,谢谢

[复制链接]
跳转到指定楼层
1#
发表于 2020-12-25 16:49:06 | 只看该作者 回帖奖励 |正序浏览 |阅读模式



请老师们给解释一下,下面的代码的含义,是一个关于使用标签模板的例子里面的,谢谢
菜鸟学习,请多关照。
'生成合格证代码
Sub test2()
Sheet2.Activate
Sheet2.UsedRange.Delete
Application.ScreenUpdating = False
Dim rng As Range, cl As Range, rg As Range, arr, brr
Dim a&, b&, i&, j&, k&, m&, n&, r&, s
r = Sheet3.Cells(Rows.Count, 6).End(3).Row
arr = Sheet3.Range("a2:h" & r).Value
Set rng = Sheet5.[a1:c11]
Set cl = rng.EntireColumn
Set rg = rng.EntireRow
brr = Sheet5.[a1:c11].Value
s = InputBox("请输入水平方向几连张", "系统提示", 5)
If IsNumeric(s) Then
    For i = 1 To UBound(arr)
       For j = 1 To arr(i, 6)
          m = m + 1
          k = Application.Ceiling(m / s, 1)
          n = IIf(m Mod s = 0, s, m Mod s)
          a = k * 11 - 10
          b = n * 3 - 2
          brr(3, 2) = arr(i, 2)
          brr(4, 2) = arr(i, 4)
          brr(5, 2) = arr(i, 5)
          brr(6, 2) = arr(i, 7)
          brr(7, 2) = arr(i, 8)
          brr(10, 1) = arr(i, 1)
          If k = 1 Then cl.Copy Cells(a, b)
          If n = 1 Then rg.Copy Cells(a, b)
          rng.Copy Cells(a, b)
          Cells(a, b).Resize(11, 3) = brr
       Next
    Next
End If
Application.ScreenUpdating = True
End Sub

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅
3#
 楼主| 发表于 2020-12-25 18:52:26 | 只看该作者
roych 老师谢谢您的帮助解释,以后向您学习。
2#
发表于 2020-12-25 17:19:23 | 只看该作者
Sub test2()
Sheet2.Activate'激活sheet2工作表
Sheet2.UsedRange.Delete'删除曾经编辑过的单元格。
Application.ScreenUpdating = False'关闭屏幕更新
Dim rng As Range, cl As Range, rg As Range, arr, brr'定义变量
Dim a&, b&, i&, j&, k&, m&, n&, r&, s
r = Sheet3.Cells(Rows.Count, 6).End(3).Row'定义行号。
arr = Sheet3.Range("a2:h" & r).Value'将A-H部分区域转为数组
Set rng = Sheet5.[a1:c11]'定义区域
Set cl = rng.EntireColumn'定义区域的列
Set rg = rng.EntireRow'定义区域的行
brr = Sheet5.[a1:c11].Value'将sheet5的区域a1:c11转为数组
s = InputBox("请输入水平方向几连张", "系统提示", 5)'定义用户输入框
If IsNumeric(s) Then'如果用户输入的是数值
    For i = 1 To UBound(arr)'UBound表示的是数组的上限。这里应该是行数
       For j = 1 To arr(i, 6)'获取H列第i行的值
          m = m + 1'自增变量
          k = Application.Ceiling(m / s, 1)'取整
          n = IIf(m Mod s = 0, s, m Mod s)'如果m能被s整除,则取s,否则就取m除以s后的余数。应该是用于将剩余数据按固定格式分割。比如,s=18,m=4,应该是4,4,4,4,2
          a = k * 11 - 10'定义变量
          b = n * 3 - 2
          brr(3, 2) = arr(i, 2)'数组赋值
          brr(4, 2) = arr(i, 4)
          brr(5, 2) = arr(i, 5)
          brr(6, 2) = arr(i, 7)
          brr(7, 2) = arr(i, 8)
          brr(10, 1) = arr(i, 1)
          If k = 1 Then cl.Copy Cells(a, b)'将整行数据复制到指定区域
          If n = 1 Then rg.Copy Cells(a, b)将整列数据复制到指定区域
          rng.Copy Cells(a, b)'将整个区域进行复制
          Cells(a, b).Resize(11, 3) = brr'调整区域为11行3列
       Next
    Next
End If
Application.ScreenUpdating = True'更新屏幕
End Sub
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-29 20:44 , Processed in 0.079112 second(s), 28 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表