[已解决]多个excel表合并的程序

vivianpan0709

附件consol中有5个excel表，格式一模一样，请各位大神帮忙写一个程序，能够实现China的数据是Beijing，Shanghai，Tianjin, Guangzhou对应单元格的加总。不想要一个一个的加，因为实际中我有10个excel表，而且每一张表的内容特别多，想学习一下如何用代码实现这个加总。比较急，谢谢谢谢！

最佳答案

月排行榜 / 总排行榜

grf1973

2015-7-7 15:13

1. Sub 导入文件()
   
2.     Application.ScreenUpdating = False
   
3.     Dim Filename, wb As Workbook, Sht As Worksheet
   
4.     [c4:aj58].ClearContents
   
5.     res = [c4:aj58]
   
6.     Filename = Dir(ThisWorkbook.Path & "\*.xls")
   
7.     Do While Filename <> ""
   
8.         If Filename <> ThisWorkbook.Name Then
   
9.             fn = ThisWorkbook.Path & "" & Filename
   
10.             Set wb = Workbooks.Open(fn)
    
11.             Set Sht = wb.Worksheets(1)
    
12.             arr = Sht.[c4:aj58]
    
13.             wb.Close False
    
14.             For i = 1 To UBound(arr)
    
15.                 For j = 1 To UBound(arr, 2)
    
16.                     If arr(i, j) <> 0 Then res(i, j) = res(i, j) + arr(i, j)
    
17.                 Next
    
18.             Next
    
19.         End If
    
20.         Filename = Dir
    
21.     Loop
    
22.     Set Sht = Nothing
    
23.     [c4:aj58] = res
    
24.     Application.ScreenUpdating = True
    
25. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

1. Sub 导入文件()
   
2.     Application.ScreenUpdating = False
   
3.     Dim Filename, wb As Workbook, Sht As Worksheet
   
4.     [c4:aj58].ClearContents
   
5.     res = [c4:aj58]
   
6.     Filename = Dir(ThisWorkbook.Path & "\*.xls")
   
7.     Do While Filename <> ""
   
8.         If Filename <> ThisWorkbook.Name Then
   
9.             fn = ThisWorkbook.Path & "" & Filename
   
10.             Set wb = Workbooks.Open(fn)
    
11.             Set Sht = wb.Worksheets(1)
    
12.             arr = Sht.[c4:aj58]
    
13.             wb.Close False
    
14.             For i = 1 To UBound(arr)
    
15.                 For j = 1 To UBound(arr, 2)
    
16.                     If arr(i, j) <> 0 Then res(i, j) = res(i, j) + arr(i, j)
    
17.                 Next
    
18.             Next
    
19.         End If
    
20.         Filename = Dir
    
21.     Loop
    
22.     Set Sht = Nothing
    
23.     [c4:aj58] = res
    
24.     Application.ScreenUpdating = True
    
25. End Sub
    

复制代码

grf1973

请看附件。

vivianpan0709

grf1973 发表于 2015-7-7 15:13
请看附件。

[em23][em23][em23]

vivianpan0709

grf1973 发表于 2015-7-7 15:13
请看附件。

不知为什么总说我回复信息有问题。。。。第16句报错，完全没基础的人看不懂哪里错啊？？？

vivianpan0709

grf1973 发表于 2015-7-7 15:13
请看附件。

我的package里有7张表，第一张是后面6张的汇总，然后有7到8个子公司要填这一套package，然后我再合并汇总。这种情况只能用VBA吧？不能一个一个建立链接吧？

grf1973

估计可能是你待导入的表中内容有非数据型。把第16句改成 If val(arr(i, j)) <> 0 Then res(i, j) = res(i, j) + val(arr(i, j)) 试试。

ardu95

下来试试 谢谢分享