[已解决]批量汇总数据的问题

小毛毛毛

附件 汇总.rar (87.73 KB, 下载次数: 21)

2015-11-10 20:22 上传

点击文件名下载附件
谢谢各位老师！

最佳答案

月排行榜 / 总排行榜

grf1973

2015-11-16 11:25

请看附件。

跳转到最佳答案楼层

小毛毛毛

碰碰运气，看哪位老师照顾一下，多谢了．

grf1973

1. Sub grf()
   
2.     Dim sh As Worksheet, wb As Workbook
   
3.     Set fso = CreateObject("scripting.filesystemobject")
   
4.     Set ff = fso.getfolder(ThisWorkbook.Path)
   
5.     Dim arr(1 To 100000, 1 To 100)
   
6.     For Each fff In ff.subfolders
   
7.        For Each f In fff.Files
   
8.          frr = Split(f, "")
   
9.          x = frr(UBound(frr) - 1) & "-" & frr(UBound(frr))     '文件夹名-工作表名
   
10.          Set wb = Workbooks.Open(f)
    
11.          For Each sh In wb.Worksheets
    
12.             If sh.UsedRange.Cells.Count > 1 Then
    
13.                 brr = sh.UsedRange
    
14.                 For i = 1 To UBound(brr)
    
15.                     n = n + 1
    
16.                     For j = 1 To UBound(brr, 2)
    
17.                         arr(n, j) = brr(i, j)
    
18.                     Next
    
19.                     arr(n, j) = x
    
20.                 Next
    
21.             End If
    
22.         Next
    
23.         wb.Close False
    
24.        Next
    
25.     Next
    
26.     If n > 0 Then [a1].Resize(n, j) = arr
    
27. End Sub
    

复制代码

grf1973

请看附件。

小毛毛毛

grf1973 发表于 2015-11-13 09:44
请看附件。

老师你好，谢谢你帮助．试了一下，运行正常．

但是如果改变工作薄中的列数，就会提示下标过界．
正常情况下，工作薄中的数据，会有5000列左右．我把第二个1 to 100，改为1 to 5000后，点一下执行，附件立马消失不在了．

想不明白是何原因．

grf1973

消失不在？什么意思？上附件

小毛毛毛

grf1973 发表于 2015-11-13 20:42
消失不在？什么意思？上附件

附件 汇总.rar (166.98 KB, 下载次数: 2)

2015-11-13 21:00 上传

点击文件名下载附件

工作薄中的数据，有４６６６列．附件运行时，会出错．如果是１００列之内，不会出错．

我把第二个１００改为５０００后，点执行，附件没了．

谢谢老师了．

小毛毛毛

grf1973 发表于 2015-11-13 20:42
消失不在？什么意思？上附件

老师你好，附件已上传到7楼。麻烦看看。

grf1973

请看附件。