标题:大神求助一个vb代码
只看楼主
wlf251
Rank: 1
等 级:新手上路
帖 子:2
专家分:0
注 册:2023-3-15
结帖率:0
已结贴  问题点数:10 回复次数:2 
大神求助一个vb代码
求大神代写一个代码,附件1为数据表,附件2为主表 把附近1里面的数据自动生成附件2表的格式  附件2的内容数据均为附件一里面的内容,

搜索更多相关主题的帖子: vb 内容 代码 数据 附件 
2023-03-15 16:24
wlf251
Rank: 1
等 级:新手上路
帖 子:2
专家分:0
注 册:2023-3-15
得分:0 
户数比较多   需要大量生成领款单 每户一份  求大神写一个代码
2023-03-15 16:25
阳光上的桥
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:25
帖 子:82
专家分:525
注 册:2023-1-12
得分:10 
这类问题一般的解决套路是:
程序代码:
sub x()
    dim db, arr, i, j
    db = sheets("附件1").usedrange ' 获取附件1的清单
    arr = sheets(附件2").usedrange ' 获取附件2的模板,注意必须从第一行开始,末尾不要有多余的空行,否则这里需要固定范围
    arr = sheets(附件2").range("a1:d8") ' 上一行失灵的时候用这行
    i = 5 ' 附件1 第一行数据的行
    j = 1 ' 附件2 开始输出内容的行
    while i<=ubound(db)
        if db(i,1)<>"" then ' 只输出【序号】不为空的行
            j = j + ubound(arr) ' 跳过模板大小的行数
            arr(2, 4) = db(i, 1) '序号 =》 编号
            '这里继续写模板各栏的赋值,可能有许多行
            with sheets(附件2")
                .rows("1:" & ubound(arr)).copy .cells(j, 1)            '复制模板区域的格式
                .cells(j, 1).resize(ubound(arr), ubound(arr,2)) = arr  '填充数据
            end with
        end if
        i = i + 1
    wend
end sub
2023-03-20 10:01



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-511549-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.055099 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved