求快速汇总设置好格式的各个文件的数据

kaka117

重新发贴，求大神解： 因为工作经常需要请各厂汇总一些数据，一般是设置好格式，请各厂填好各自的数据回复一个个单独文件，然后再一个个贴上去，量大，有点浪费时间，有没快速合并各厂数据的方式？ 数据参附件

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim wb As Workbook
   
5.   Dim ws As Worksheet
   
6.   Dim mypath$, myname$
   
7.   Application.ScreenUpdating = False
   
8.   Application.DisplayAlerts = False
   
9.   With Worksheets("sheet1")
   
10.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
11.     c = .Cells(1, .Columns.Count).End(xlToLeft).Column
    
12.     arr = .Range("a2").Resize(r - 1, c)
    
13.   End With
    
14.   mypath = ThisWorkbook.Path & ""
    
15.   For k = 1 To UBound(arr)
    
16.     myname = Left(arr(k, 1), 1) & ".xlsx"
    
17.     If Dir(mypath & myname) <> "" Then
    
18.       Set wb = GetObject(mypath & myname)
    
19.       With wb
    
20.         With .Worksheets("sheet1")
    
21.           brr = .Range("a2").Resize(r - 1, c)
    
22.           For i = 1 To UBound(brr)
    
23.             If brr(i, 1) = arr(k, 1) Then
    
24.               For j = 1 To UBound(brr, 2)
    
25.                 arr(k, j) = brr(i, j)
    
26.               Next
    
27.             End If
    
28.           Next
    
29.         End With
    
30.         .Close False
    
31.       End With
    
32.     End If
    
33.   Next
    
34.   With Worksheets("sheet1")
    
35.     .Range("a2").Resize(r - 1, c) = arr
    
36.   End With
    
37.   
    
38. End Sub
    

复制代码

小小鸟前滚翻

论坛里这样的例子很多

chxw68

楼主举的例子非常规范，现实数据肯定不是这样的，代码仅供参考。

Yalishanda30

附件供参考