vba复制同一文件夹下其他工作簿中某一工作表的数据到汇总工作簿的某一工作表
1基本情况1.1一文件夹下有汇总表和多个数据表1.2数据表个数不定,且数据表名无规则1.3所有数据表中有一个格式一样的“汇总用数据”工作表1.4汇总表中有一表名为“数据”...
1 基本情况
1.1一文件夹下有 汇总表和多个数据表
1.2数据表个数不定,且数据表名无规则
1.3所有数据表中有一个格式一样的“汇总用数据”工作表
1.4汇总表中有一表名为“数据”的工作表,此表与数据表中“汇总用数据”工作表格式一样
2 想要实现效果
VBA复制所有数据表中的“汇总用数据”工作表中的数据至汇总表的“数据”中。 展开
1.1一文件夹下有 汇总表和多个数据表
1.2数据表个数不定,且数据表名无规则
1.3所有数据表中有一个格式一样的“汇总用数据”工作表
1.4汇总表中有一表名为“数据”的工作表,此表与数据表中“汇总用数据”工作表格式一样
2 想要实现效果
VBA复制所有数据表中的“汇总用数据”工作表中的数据至汇总表的“数据”中。 展开
2011-08-26
展开全部
最后这个效果好像不清楚,N个相同格式的表格,“复制到”格式相同的一个工作表?如何复制?复制完还格式相同?
应该说明,N个源表向汇总表转移(汇总)数据的具体方式:
一是顺序追加:即每一源表,复制后,按先后顺序,原样(保留格式和数值,去掉公式)粘贴数值到汇总表的不同行位置。例如:源表1有1个数据A,源表2有1个数据B,汇总表就是2个数据A和B(这种方式不要求汇总表有格式,汇总表实际是一个记录不断增多的叠加表)
二是定位加总:即每一源表,复制后,将数值累加或其他运算方式汇总到汇总表的对应单元格。L例如:源表1有1个数据5,源表2有1个数据3,求和的汇总表就是1个数据8,计数的汇总表就是1个数据2。(这种方式必须保持汇总表与源表格式一致,但要定义好每个单元的汇总规则)
最常用的定位加总是单元格数值累加,也叫求和
其次有均值、最大值、最小值、中值、计数等等等等
对于字符单元,也有合并、计数和忽略
你要哪种?
应该说明,N个源表向汇总表转移(汇总)数据的具体方式:
一是顺序追加:即每一源表,复制后,按先后顺序,原样(保留格式和数值,去掉公式)粘贴数值到汇总表的不同行位置。例如:源表1有1个数据A,源表2有1个数据B,汇总表就是2个数据A和B(这种方式不要求汇总表有格式,汇总表实际是一个记录不断增多的叠加表)
二是定位加总:即每一源表,复制后,将数值累加或其他运算方式汇总到汇总表的对应单元格。L例如:源表1有1个数据5,源表2有1个数据3,求和的汇总表就是1个数据8,计数的汇总表就是1个数据2。(这种方式必须保持汇总表与源表格式一致,但要定义好每个单元的汇总规则)
最常用的定位加总是单元格数值累加,也叫求和
其次有均值、最大值、最小值、中值、计数等等等等
对于字符单元,也有合并、计数和忽略
你要哪种?
追问
我要实现的是第一种,数据叠加表。
追答
汇总表文件中用宏。最好在汇总表上增加2列,记录文件名称和表单名称,以便修改和对照检查
大体方案如下:
lj="C:\" '存放源表的路径名称
k=0
e=0
Set s = CreateObject("Scripting.FileSystemObject")
Set d = s.GetFolder(lj)
Set f = d.Files
For Each w In f '逐个文件处理
wnm = w.Name
With Cells
Set u = .Find(wnm, LookIn:=xlValues) '汇总表内找同名文件
If Not u Is Nothing Then '找到同名文件
k = 1
Else
k = 0
End If
Set u = Nothing
End With
e=e+1 '文件计数
If (LCase(Right(wnm, 3)) = "xls") And (wnm ThisWorkbook.Name) And (k = 0) Then '如果是表单内没有的XLS文件,就打开它
FL = lj + w.Name
Application.StatusBar = "正打开文件:" + w.Name
On Error GoTo cw001
Workbooks.Open FL
On Error GoTo 0
Application.StatusBar = False
'此处可以根据表单结构对需要叠加的表单记录进行处理
'可先计算数据追加起始行和源表数据区地址,转换为追加地址后,用复制或赋值命令完成追加
ActiveWorkbook.Close False
End If
Next w
Set f = Nothing
Set d = Nothing
Set s = Nothing
MsgBox "叠加完成,共" + CStr(e) + "个文件", vbOKOnly, "报告"
Exit Sub
cw001:
Workbooks(w.Name).Activate
Resume Next
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询