请教各位老师，如何把不同文件夹路径下的工作簿汇总到总表

zzj0388

因为各部门都有各自的台账，并存在各自部门的文件夹下面，现在需要将大家的台账用VBA汇总到总表，A列编号是共同唯一的数据，但是真实的数据太多了，如果一个一个复制太慢了，而且各部门还不定期录入新数据，所以请教各位老师怎么用VBA实现这个功能节省工作时间，非常感谢。

松永

各部门上交时的编号一样吗？或者可否在汇总表里把编号先都写上？

zzj0388

松永 发表于 2024-11-15 14:50
各部门上交时的编号一样吗？或者可否在汇总表里把编号先都写上？

各部门上交用的编号是一样的，可以在汇总表里把编号先写上

shiruiqiang

双字典汇总还是比较简单

zzj0388

不会做

一执成念

https://club.excelhome.net/thread-1706015-1-1.html

ykcbf1100

全表自动生成

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.11.15
   
2.     Application.ScreenUpdating = False
   
3.     Set fso = CreateObject("Scripting.FileSystemObject")
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Set sh = ThisWorkbook.Sheets("汇总表")
   
6.     p = ThisWorkbook.Path & ""
   
7.     ReDim brr(1 To 10000, 1 To 100)
   
8.     m = 1: n = 1
   
9.     brr(1, 1) = "编号"
   
10.     For Each fd In fso.GetFolder(p).SubFolders
    
11.         For Each f In fso.GetFolder(fd).Files
    
12.             Set wb = Workbooks.Open(f, 0)
    
13.             With wb.Sheets(1)
    
14.                 r = .Cells(Rows.Count, 1).End(3).Row
    
15.                 c = .UsedRange.Columns.Count
    
16.                 arr = .[a1].Resize(r, c)
    
17.             End With
    
18.             wb.Close 0
    
19.             For i = 2 To UBound(arr)
    
20.                 s = arr(i, 1)
    
21.                 If Not d.exists(s) Then
    
22.                     m = m + 1
    
23.                     d(s) = m
    
24.                     brr(m, 1) = s
    
25.                 End If
    
26.                 r = d(arr(i, 1))
    
27.                 For j = 2 To UBound(arr, 2)
    
28.                     s = arr(1, j)
    
29.                     If Not d.exists(s) Then
    
30.                         n = n + 1
    
31.                         d(s) = n
    
32.                         brr(1, n) = s
    
33.                     End If
    
34.                     c = d(arr(1, j))
    
35.                     brr(r, c) = arr(i, j)
    
36.                 Next
    
37.             Next
    
38.         Next
    
39.     Next
    
40.     With sh
    
41.         .UsedRange.Clear
    
42.         .[a1].Resize(1, n).Interior.Color = 49407
    
43.         .[a1].Resize(1, n).WrapText = True
    
44.         With .[a1].Resize(m, n)
    
45.             .Value = brr
    
46.             .Borders.LineStyle = 1
    
47.             .HorizontalAlignment = xlCenter
    
48.             .VerticalAlignment = xlCenter
    
49.         End With
    
50.     End With
    
51.     Application.ScreenUpdating = True
    
52.     Set d = Nothing
    
53.     MsgBox "OK！"
    
54. End Sub
    

复制代码

风过天涯

建个写个路径表，在A列让各部门维护自己的文件路径，然后普通的汇总程序上外围嵌套一层循环路径表A列的值，就可以了

风过天涯

ykcbf1100 发表于 2024-11-15 16:01
全表自动生成

草爷，他要不同路径，我是觉得建个路径表，外围嵌套一层循环路径就好了