| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1665 人关注过本帖
标题:关于EXCEL多个子表复制到另一个EXCEL对应子表
只看楼主 加入收藏
li198922
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2020-10-9
结帖率:0
收藏
已结贴  问题点数:20 回复次数:2 
关于EXCEL多个子表复制到另一个EXCEL对应子表
需要将附件中《数据源》里面的数据从表三开始往后的子表,数量列非空白项复制到《复制模板》里面,最总形成《成果》样式的表格,每天都是重复粘贴复制,有没有快速解决的办法
学习软件.rar (1.39 MB)
搜索更多相关主题的帖子: 复制 对应 多个 子表 EXCEL 
2020-10-09 14:36
厨师王德榜
Rank: 18Rank: 18Rank: 18Rank: 18Rank: 18
等 级:贵宾
威 望:199
帖 子:989
专家分:4966
注 册:2013-2-16
收藏
得分:20 
自己录制一个宏 ,再对录制的宏进行适当的修改,应该可以满足需要.
2020-10-15 14:02
厨师王德榜
Rank: 18Rank: 18Rank: 18Rank: 18Rank: 18
等 级:贵宾
威 望:199
帖 子:989
专家分:4966
注 册:2013-2-16
收藏
得分:0 
算了,正好有点时间,给你写一个吧,其余的模块,你可以自己仿照示例来写.
程序代码:
Attribute VB_Name = "copySheet"
'运行前, 数据源  和 【复制模板】 必须同时打开 !!
Public Function cpSht2Sht(ByVal iColflag As Integer, _
    iStartRow As Integer, iStartRow2 As Integer, _
    cSurSht As String, cTarSht As String, _
    ByRef arrColist) As Boolean
' 共用模块,拷贝Sheet间数据
' 参数说明:非零标志位 ,起始行,源Sheet,目标Sheet ,列对应数组.
' 为了简捷,这里省略了Error 处理语句,用户可以自己添加上.
Dim sht0 As Worksheet, sht1 As Worksheet
Dim iArrRow As Integer, iLastCol As Integer, iLastRow As Integer
Dim irow As Integer, icol As Integer
Dim arrData()
iArrRow = UBound(arrColist, 1)
iLastCol = arrColist(iArrRow, 0)  '获取终止列,至于起始列,默认是 arrColist(0, 0)

Set sht0 = Workbooks("数据源.xls").Worksheets(cSurSht)
Set sht1 = Workbooks("【复制模板】.xlsx").Worksheets(cTarSht)
'获取终止行 ,起始行则由参数2获取.
sht0.Activate

 iLastRow = sht0.UsedRange.Rows.Count

 arrData = sht0.Range(Cells(iStartRow, arrColist(0, 0)), Cells(iLastRow, iLastCol)).Value
'开始输出数据
sht1.Activate

For irow = 1 To UBound(arrData, 1)
    If arrData(irow, iColflag) <> 0 And arrData(irow, iColflag) <> "." Then
        For icol = 0 To iArrRow
            sht1.Cells(iStartRow2, arrColist(icol, 1)).Value = arrData(irow, icol + 1)
        Next icol
        iStartRow2 = iStartRow2 + 1 ' 目标表的起始输入行.
    End If
Next irow
ReDim arrData(0, 0)
cpSht2Sht = True
End Function

Sub CopySht()
Dim rlt As Boolean
Dim 参数1 As Integer, 参数2 As Integer, 参数3 As Integer
Dim 参数4 As String, 参数5 As String
'调用cpSht2Sht示例
'比如要把数据源的[表三甲]复制到模块的的[表三甲]中去,那么:
'数据源的[表三甲]的第5列非零时,需要复制,所以参数1 = 5
参数1 = 5
'从数据源的[表三甲]的第8行开始复制,所以参数2=8
参数2 = 8
'从目标表的[表三甲]的第8行开始输出,所以参数3=8
参数3 = 8
'源表名称:"表三甲",所以参数4="表三甲"
参数4 = "表三甲"
'目标表名称:"表三甲",所以参数5="表三甲"
参数5 = "表三甲"
'接下来,需要定义源表与目标表之间的列对应关系(参数6,是一个数组)
'由于有7列数列需要复制,故定义数组为7行,2列:
Dim arr1(6, 1) As Integer
arr1(0, 0) = 1: arr1(0, 1) = 2  '源表第1列,复制到目标表第2列
arr1(1, 0) = 2: arr1(1, 1) = 3  '源表第2列,复制到目标表第3列
arr1(2, 0) = 3: arr1(2, 1) = 4  '......
arr1(3, 0) = 4: arr1(3, 1) = 5
arr1(4, 0) = 5: arr1(4, 1) = 6 '直到下一行,有变化:
arr1(5, 0) = 6: arr1(5, 1) = 8 '源表第6列,复制到目标表第8列
arr1(6, 0) = 7: arr1(6, 1) = 9
' 6个参数定义完毕,以下调用公共模块,开始复制/写数据:
rlt = cpSht2Sht(参数1, 参数2, 参数3, 参数4, 参数5, arr1)
Debug.Print (rlt)
' 参照以上示例,可以把其它几个表间复制的动作都写成类似CopySht()这样的子程序,
' 而公共模块cpSht2Sht,可反复调用.
End Sub

' 参照以上示例,假定需要复制 [表四甲甲供材料表] -->[主材 (甲供)],可以这样做:
Sub CopySht2()
Dim rlt As Boolean
Dim 参数1 As Integer, 参数2 As Integer, 参数3 As Integer
Dim 参数4 As String, 参数5 As String
'调用cpSht2Sht示例
'数据源的[表四甲甲供材料表]的第9列非零时,需要复制,所以参数1 = 9
参数1 = 9
'从数据源的[表四甲甲供材料表]的第8行开始复制,所以参数2=8
参数2 = 8
'从目标表的[主材 (甲供)]的第7行开始输出,所以参数3=8
参数3 = 7
'源表名称:"表四甲甲供材料表",所以参数4="表四甲甲供材料表"
参数4 = "表四甲甲供材料表"
'目标表名称:"主材 (甲供)",所以参数5="主材 (甲供)"
参数5 = "主材 (甲供)"
'接下来,需要定义源表与目标表之间的列对应关系(参数6,是一个数组)
'由于有6列数列需要复制,故定义数组为6行,2列:
Dim arr1(5, 1) As Integer
arr1(0, 0) = 1: arr1(0, 1) = 2  '源表第1列,复制到目标表第2列
arr1(1, 0) = 2: arr1(1, 1) = 3  '源表第2列,复制到目标表第3列
arr1(2, 0) = 3: arr1(2, 1) = 4  '......
arr1(3, 0) = 4: arr1(3, 1) = 5
arr1(4, 0) = 5: arr1(4, 1) = 6 '直到下一行,有变化:
arr1(5, 0) = 6: arr1(5, 1) = 8 '源表第6列,复制到目标表第8列

' 6个参数定义完毕,以下调用公共模块,开始复制/写数据:
rlt = cpSht2Sht(参数1, 参数2, 参数3, 参数4, 参数5, arr1)
Debug.Print (rlt)

End Sub
2020-10-15 15:53
快速回复:关于EXCEL多个子表复制到另一个EXCEL对应子表
数据加载中...
 
   



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

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