多工作簿数据汇总问题

emaildai78

如附件，把附件中的两个工作簿B00060LBP、B00061LXS的文件名及内容按汇总表的格式汇总，附件文件夹内会有很多工作簿，工作表表头格式一样，数据行数不一样，汇总表中黄色为新增加的列。

lsc900707

问题不难，晚点答复。

abc123281

呵呵  老师  很麻烦的   分表中有很多合并单元格

abc123281

这些分表太不规范

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr(1 To 10000, 1 To 11)
   
4.   Dim wb As Workbook
   
5.   Dim ws As Worksheet
   
6.   Dim mypath$, myname$
   
7.   Application.ScreenUpdating = False
   
8.   Application.DisplayAlerts = False
   
9.   mypath = ThisWorkbook.Path & ""
   
10.   myname = Dir(mypath & "*.xls")
    
11.   m = 0
    
12.   Do While myname <> ""
    
13.     If myname <> ThisWorkbook.Name Then
    
14.       Set wb = GetObject(mypath & myname)
    
15.       wjm = Split(myname, ".")(0)
    
16.       With wb
    
17.         With .Worksheets(1)
    
18.           r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
19.           arr = .Range("a5:q" & r)
    
20.           For i = 6 To UBound(arr)
    
21.             m = m + 1
    
22.             brr(m, 1) = arr(i, 1)
    
23.             brr(m, 2) = wjm
    
24.             brr(m, 3) = arr(1, 3)
    
25.             brr(m, 4) = arr(3, 3)
    
26.             brr(m, 5) = arr(i, 2)
    
27.             brr(m, 6) = arr(i, 4)
    
28.             brr(m, 7) = arr(i, 6)
    
29.             brr(m, 8) = arr(i, 10)
    
30.             brr(m, 9) = arr(i, 13)
    
31.             brr(m, 10) = arr(i, 15)
    
32.             brr(m, 11) = arr(i, 17)
    
33.           Next
    
34.         End With
    
35.         .Close False
    
36.       End With
    
37.     End If
    
38.     myname = Dir
    
39.   Loop
    
40.   With Worksheets("sheet1")
    
41.     .Range("a3:k" & .Rows.Count).ClearContents
    
42.     .Range("a3").Resize(m, UBound(brr, 2)) = brr
    
43.   End With
    
44. End Sub
    
45. 
    

复制代码

chxw68

写代码过程中才发现，楼主原始表格中有很多合并单元格，这样设计表格真的让人醉了。

emaildai78

这是从系统中导出来的表格。数据项合并的的，可以按原来的复制过来。在汇总表中再处理合并项。

lsc900707

abc123281 发表于 2018-3-12 18:30
呵呵  老师  很麻烦的   分表中有很多合并单元格

那就算了，我本来就有很多事情要处理，没有那么多时间来看数据。

emaildai78

非常感谢老师的帮助。这样节省好多工作量。

abc123281

呵呵  他鲜花也不会送给帮助他的人