用VBA跨表提取数据

梁晓璇

用VBA跨表提取数据
各位大神，如何将文件夹里面的982表提取到新的表格里面

ykcbf1100

你这个综合汇总表是本来就有的，还是要新建的？

梁晓璇

ykcbf1100 发表于 2024-12-13 15:31
你这个综合汇总表是本来就有的，还是要新建的？

982表分别在两个文件夹各有一个，我想新建一个表，把两个表的数据提取在一起

ykcbf1100

梁晓璇 发表于 2024-12-13 15:53
982表分别在两个文件夹各有一个，我想新建一个表，把两个表的数据提取在一起

你是想把二个表提取到一个工作簿中的二个表还是合并到一个表上？

梁晓璇

ykcbf1100 发表于 2024-12-13 15:59
你是想把二个表提取到一个工作簿中的二个表还是合并到一个表上？

合并在一个表

z865593849

汇总文件

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.12.13
   
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.     For Each fd In fso.GetFolder(p).SubFolders
   
9.         For Each f In fso.GetFolder(fd).Files
   
10.             Set wb = Workbooks.Open(f, 0)
    
11.             arr = wb.Sheets("Sheet1").UsedRange
    
12.             wb.Close 0
    
13.             For i = 2 To UBound(arr)
    
14.                 If arr(i, 2) <> Empty Then
    
15.                     s = arr(i, 2)
    
16.                     If Not d.exists(s) Then
    
17.                         m = m + 1
    
18.                         d(s) = m
    
19.                         brr(m, 1) = CDate(s)
    
20.                         brr(m, 4) = 1
    
21.                         brr(m, 5) = arr(i, 3)
    
22.                     Else
    
23.                         r = d(s)
    
24.                         brr(r, 4) = brr(r, 4) + 1
    
25.                         brr(r, 5) = brr(r, 5) + arr(i, 3)
    
26.                     End If
    
27.                 End If
    
28.             Next
    
29.         Next
    
30.     Next
    
31.     With Sh
    
32.         .UsedRange.Offset(3).ClearContents
    
33.         .[a4].Resize(m, 5) = brr
    
34.         .[a4].Resize(m, 5).Borders.LineStyle = 1
    
35.     End With
    
36.     Set d = Nothing
    
37.     Application.ScreenUpdating = True
    
38.     MsgBox "共用时：" & Format(Timer - tm) & "秒！"
    
39. End Sub
    

复制代码

ykcbf1100

z865593849 发表于 2024-12-13 16:33
汇总文件

你理解错了，你没看汇总表？
排重汇总的。

梁晓璇

ykcbf1100 发表于 2024-12-13 16:34
附件供参考。。。

谢谢老师，感激不尽