合并报表相关问题

悠悠虎

做合并报表，每个月收集样式一样的子公司报表，然后把子公司的数据一个个黏贴到合并底稿上，子公司多，很浪费时间，有没有方法，可以自动提取不同工作簿之间的数据。

xiefeng429429

最好上传一下附件，举个例子吧！

wajour

用dir遍历同文件夹的所有xls文档，利用选择性粘贴+功能实现对应累加
~~~我们分公司的报表就是利用这个功能实现的，代码我已经写好了

1. Sub 汇总(区域 As String)    '区域参数以样式 "A1:B1-C3:D8"
   
2.     If MsgBox("亲，是否对 (" & ActiveSheet.Name & ") 进行汇总？", vbYesNo, "问问您老人家") = vbYes Then
   
3.         Dim str As String, Rng1 As Range, Rng() As String
   
4.             Rng = Split(区域 & "-", "-") '将参数劈开得到区域地址数组
   
5. Application.ScreenUpdating = False  '关闭屏幕刷新加快速度
   
6.         N = ActiveSheet.Index   '取得活动工作表序号
   
7.         Mypath = ThisWorkbook.Path  '汇总工作簿文档路径
   
8. On Error Resume Next    '跳过错误往下执行
   
9. For i = 0 To UBound(Rng)    '获得参数指定汇总表格中的区域方便清空跟后面清除0值
   
10.     If Rng1 Is Nothing Then
    
11.     Set Rng1 = ThisWorkbook.Sheets(N).Range(Rng(i))
    
12.     Else
    
13.     Set Rng1 = Union(Rng1, ThisWorkbook.Sheets(N).Range(Rng(i)))
    
14.     End If
    
15. Next
    
16.     Rng1.ClearContents   '清空单元格区域
    
17. Application.ScreenUpdating = True
    
18.         strName = Dir(Mypath & "" & "*.xls")  '获得路径下第一个Excel表文件名
    
19. Application.ScreenUpdating = False
    
20. 
    
21. Do While strName <> ""     '运行到最后一个文件名称
    
22.     If strName <> ThisWorkbook.Name Then   '判断为非汇总工作表
    
23.         Count = Count + 1 '计数次数
    
24.     With Workbooks.Open(Mypath & "" & strName) '打开工作簿
    
25.         str = str & Chr$(13) & strName
    
26.     For i = 0 To UBound(Rng) '循环设置的区域
    
27.         .Sheets(N).Range(Rng(i)).Copy '从打开文档中copy指定区域
    
28.              ThisWorkbook.Sheets(N).Range(Rng(i)).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
    
29.             :=False, Transpose:=False '选择性粘贴到汇总表格对应区域使用数值"加"运算
    
30. Next i
    
31.         .Close False '关闭工作簿不保存修改
    
32. End With
    
33. End If
    
34. strName = Dir '读取下一个Excel表文件名
    
35. Loop
    
36. For Each cell In Rng1 '清除区域中为0的单元格值
    
37.     If cell < 0.001 And cell >= 0 Then
    
38.         cell.ClearContents
    
39.     End If
    
40. Next
    
41. Application.ScreenUpdating = True '恢复屏幕刷新
    
42. MsgBox "工作表-" & ActiveSheet.Name & Chr$(13) & "共汇总" & Count & "个工作簿金额" & Chr$(13) & str, Title:="哈哈！" '提示
    
43. Rng1.Select
    
44. Else
    
45. Exit Sub
    
46. End If
    
47. End Sub

复制代码

goodlong

• 合并报表貌似不是所有子公司相加这么简单哎，可是我原来认识某个有事务所（有上市公司审计资质的）就是这么干的。
• 简单相加汇总的，就用excel插件把，论坛搜索佛山小老鼠大大的工具箱，或者置顶的易用宝。
  

wajour

....这个是粘贴到notepad的代码

悠悠虎

wajour 发表于 2012-9-30 00:00
....这个是粘贴到notepad的代码

不懂，能否给个案例！

wanglizhihappy

用sumif 函数

散落天涯

wajour 发表于 2012-9-30 00:00
....这个是粘贴到notepad的代码

能否把你的合并报表原件发给我，学习，谢谢

xjyltysy11

了解了解啊

ynyefeng

有意思，支持一下！