合并统计数据，求热心大哥给予完善

fleaaa

合并统计数据，求热心大哥给予完善。


本人小白，抄了一段代码，但是距离实际要求还有很大差距，求各位大哥给予帮助，万分感激

1、历遍同目录下所有文件合并，去掉表头。
2、按照列值，分类排序。
最终效果就是将test1、test2和test3合并实现成汇总表的最终结果。

三分醉，七分醒

要求不具体，无法完成

fleaaa

三分醉，七分醒 发表于 2023-5-11 09:35
要求不具体，无法完成

非常感激您的热心关注！！！重新更新了一下，最终效果就是将test1、test2和test3合并实现成汇总表的最终结果。

盼盼198310

fleaaa 发表于 2023-5-11 09:47
非常感激您的热心关注！！！重新更新了一下，最终效果就是将test1、test2和test3合并实现成汇总表的最终 ...

...............

3190496160

Sub 汇总()
Application.ScreenUpdating = False
lj = ThisWorkbook.Path & "\"
With Sheets("汇总表")
    .UsedRange.Offset(5).Clear
    f = Dir(lj & "*.xls*")
    Do While f <> ""
        If f <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(lj & f, 0)
            Set sht = wb.Worksheets(1)
            r = sht.Cells(Rows.Count, 1).End(xlUp).Row
            If r >= 5 Then
                 rs = .Cells(Rows.Count, 1).End(xlUp).Row
                sht.Rows("5:" & r).Copy .Cells(rs, 1)
            End If
            wb.Close False
        End If
    f = Dir
    Loop
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

3190496160

统计汇总表.rar (87.47 KB, 下载次数: 19)

2023-5-11 11:03 上传

点击文件名下载附件

3190496160

统计汇总表文件中有多个工作表，楼主连要汇总到哪个工作表中都没说，
目前的代码时汇总到  汇总表  中供参考

吴中泉

不当大哥好多年,给你完善了一下,符合你以上所需,请测试.
VBA多文件统计汇总表.zip (144.76 KB, 下载次数: 15)

2023-5-11 13:20 上传

点击文件名下载附件

吴中泉

1. Sub 汇总()
   
2. Application.ScreenUpdating = False
   
3. lj = ThisWorkbook.Path & ""
   
4. With Sheets("汇总表")
   
5.     .Rows("6:200000").Clear
   
6.     f = Dir(lj & "*.xls*")
   
7.     Do While f <> ""
   
8.         If f <> ThisWorkbook.Name Then
   
9.             Set wb = Workbooks.Open(lj & f, 0)
   
10.             Set sht = wb.Worksheets(1)
    
11.             r = sht.Cells(Rows.Count, 2).End(xlUp).Row
    
12.             If r >= 5 Then
    
13.                 rs = .Cells(Rows.Count, 2).End(xlUp).Row + 1
    
14.                 If rs < 6 Then rs = 6
    
15.                 sht.Rows("6:" & r).Copy .Cells(rs, 1)
    
16.             End If
    
17.             wb.Close False
    
18.         End If
    
19.     f = Dir
    
20.     Loop
    
21. End With
    
22. 分类排序
    
23. Application.ScreenUpdating = True
    
24. MsgBox "ok!"
    
25. End Sub
    
26. Sub 分类排序()
    
27. Sheets("汇总表").Rows.Copy Sheets("按行业汇总").[a1]
    
28. With Sheets("按行业汇总")
    
29.     r = .Cells(Rows.Count, 2).End(xlUp).Row
    
30.     .Rows("6:" & r).Sort [D5], Header:=xlNo
    
31. End With
    
32. Sheets("汇总表").Rows.Copy Sheets("按产值汇总").[a1]
    
33. With Sheets("按产值汇总")
    
34.     r = .Cells(Rows.Count, 2).End(xlUp).Row
    
35.     .Rows("6:" & r).Sort [e5], Header:=xlNo
    
36. End With
    
37. Sheets("汇总表").Rows.Copy Sheets("按增长率").[a1]
    
38. With Sheets("按增长率")
    
39.     r = .Cells(Rows.Count, 2).End(xlUp).Row
    
40.     .Rows("6:" & r).Sort [g5], Header:=xlNo
    
41. End With
    
42. 
    
43. End Sub
    

复制代码