多工作簿报表汇总

4684890

清风竹- 发表于 2013-3-27 12:29
换台电脑，用07excel做的，经测试可以用，请楼主测试一下。

很好用，太感谢您了

4684890

清风竹- 发表于 2013-3-27 12:29
换台电脑，用07excel做的，经测试可以用，请楼主测试一下。

我是个VBA白痴，还得根据实际表修改一下，您能否给简单解释一下- -#

4684890

清风竹- 发表于 2013-3-27 12:29
换台电脑，用07excel做的，经测试可以用，请楼主测试一下。

Sub 利润汇()
Dim wj As String, fs As Object
Application.ScreenUpdating = False
Application.DisplayAlerts = False
wj = Dir(ThisWorkbook.Path & "\*.xlsx")
Do While wj <> ""
If wj <> ThisWorkbook.Name Then
Set fs = GetObject(ThisWorkbook.Path & "\" & wj)
For i = 3 To Range("IV5").End(xlToLeft).Column
If Cells(6, i).Value = Split(wj, ".xlsx")(0) Then
i2 = i
Exit For
End If
Next
  fs.Sheets("利润分析表（月度）").Range("C9:C40").Offset(0, (Split([a3], "月")(0)) - 1).Copy Destination:=Cells(9, i2).Resize(35, 1)
fs.Close
End If
wj = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub


根据数据位置改了一点，但是第一列的公司返回的是1月的数，第二列的公司返回的就是2月的数了- -#不知是哪错了

清风竹-

4684890 发表于 2013-3-27 18:49
Sub 利润汇()
Dim wj As String, fs As Object
Application.ScreenUpdating = False

fs.Sheets("利润分析表（月度）").Range("C9:C40")，其中.Range("C9:C40")是1月数据所在区域。如1月数所在区域改成e9:e40，语句要改成fs.Sheets("利润分析表（月度）").Range("E9:E40")……

清风竹-

4684890 发表于 2013-3-27 18:49
Sub 利润汇()
Dim wj As String, fs As Object
Application.ScreenUpdating = False

1. Sub 资负汇()
   
2. Dim wj As String, fs As Object
   
3. Application.ScreenUpdating = False    '关闭屏幕刷新
   
4. Application.DisplayAlerts = False     '禁止弹出对话框
   
5. wj = Dir(ThisWorkbook.Path & "\*.xlsx") '中的*号表示本文件夹下所有的xlsx文件，是通配符；
   
6. Do While wj <> ""                      'Do   Loop一种循环语句,一直循环到找不到工作簿.
   
7. If wj <> ThisWorkbook.Name Then   '如果,在本文件夹内,找到的工作簿名不是本工作簿(汇总),那么
   
8. Set fs = GetObject(ThisWorkbook.Path & "" & wj)   '打开这个工作簿,是按循环顺序打开其中的一个
   
9. For i = 2 To Range("IV5").End(xlToLeft).Column   'For   Next一种循环语句   i = 2 To  第5行(店名)有数据最后一列的列数
   
10. If Cells(5, i).Value = Split(wj, ".xlsx")(0) Then '如果单元格的店名与找到的工作簿名称数据一致,那么
    
11. i2 = i      '工作簿名称与店名相同时 店名所在的列数i2
    
12. Exit For     '退出i的循环
    
13. End If         '上3行If结束语句
    
14. Next        '上5行For 结束语句
    
15.   fs.Sheets("资产负债表").Range("D7:D85").Offset(0, (Split([a3], "月")(0)) - 1).Copy Destination:=Cells(6, i2).Resize(79, 1)  
    
16.   '刚打开的工作簿中的,表Sheets("资产负债表"),区域Range("D7:D85")是1月份数据的区域,这句Offset(0, (Split([a3], "月")(0)) - 1)表   '示区域Range("D7:D85")的偏移量,行不偏移0,列的偏移量为,月数减1,
    
17.   '(Split([a3], "月")(0))意思为,A3格某月的月字替换掉,只留数字.如果是2月,区域的偏移量为2-1=1,则区域Range("D7:D85")向右偏移1列,实际为Range("F7:F85")
    
18.   '复制这个区域,粘贴到本工作表(资产负债表)的第6行第i2列,行数79行,1列的区域.
    
19. fs.Close '关闭刚打开的这个工作簿
    
20. End If '上10行If结束语句
    
21. wj = Dir '寻找下一个工作簿
    
22. Loop 'Do的结束语句,进行下一个循环.
    
23. Application.DisplayAlerts = True '恢复屏幕刷新
    
24. Application.ScreenUpdating = True '恢复弹出对话框
    
25. 
    
26. End Sub

复制代码

以上解释有的不太专业，不太全面，不太准确，供参考。

4684890

清风竹- 发表于 2013-3-27 19:32
以上解释有的不太专业，不太全面，不太准确，供参考。

很好了，谢谢你啊，下午等待过程中自己一句句百度了一下
现在还是假设C列的一分店，返回的是1月数据，D列的二分店就是2月数据，E列的3分店就是3月数据，怎么都调不好了，烦死了，怀疑是列偏移或者是循环的问题- -#现在就和我楼上输得内容一样，不知道为啥子就是偏

清风竹-

4684890 发表于 2013-3-27 20:08
很好了，谢谢你啊，下午等待过程中自己一句句百度了一下
现在还是假设C列的一分店，返回的是1月数据，D列 ...

把变动后的附件上传,我看一看,

4684890

清风竹- 发表于 2013-3-27 20:22
把变动后的附件上传,我看一看,

因为一个工作簿中有30张表，我刚才都删除后，突然发觉返回的是1月的了
然后我试了一下
30个表中有一个表叫“利润分析表”，然后我要汇总的是“利润分析表（月度）”，当我把“利润分析表”删除后，月度就能正常汇总...

清风竹-

4684890 发表于 2013-3-27 20:47
因为一个工作簿中有30张表，我刚才都删除后，突然发觉返回的是1月的了
然后我试了一下
30个表中有一个表 ...

把"利润分析表"变成"(利润分析表)"或加其他符号,在前面加,不删除试试.

4684890

清风竹- 发表于 2013-3-27 21:03
把"利润分析表"变成"(利润分析表)"或加其他符号,在前面加,不删除试试.

恩恩，明天我再都试试看，这两天真是太感谢你了哈