请教：如何汇总匹配数据

prowl

请教：需求是：

1、文件夹中有4个工作簿。把每个工作簿的sheet1的内容以原格式汇总到
“汇总表”工作簿中。
从A列开始显示汇总内容
2、汇总后同时与“汇总表”中的I列内容进行匹配，如果匹配成功
则把A列的内容填到H列上。
举例达到的效果是如下：

yynrzwh

新建文件夹 (4).zip (51.21 KB, 下载次数: 3)

2024-6-18 21:47 上传

点击文件名下载附件

prowl

yynrzwh 发表于 2024-6-18 21:47

多谢老师了

longwin

请测试.......

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.6.18
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set fso = CreateObject("scripting.filesystemobject")
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     Set sh = ThisWorkbook.Sheets("汇总")
   
7.     sh.[a:d].ClearContents
   
8.     p = ThisWorkbook.Path & "\新建文件夹"
   
9.     For Each f In fso.GetFolder(p).Files
   
10.         fn = fso.GetBaseName(f)
    
11.         m = m + 1
    
12.         Set Wb = Workbooks.Open(f, 0)
    
13.         With Wb.Sheets(1)
    
14.             r = IIf(m = 1, 1, sh.Cells(Rows.Count, 1).End(xlUp).Offset(2).Row)
    
15.             .UsedRange.Copy sh.Cells(r, 1)
    
16.             Wb.Close 0
    
17.         End With
    
18.     Next f
    
19.     With sh
    
20.         r = .Cells(Rows.Count, 2).End(3).Row
    
21.         arr = .[a1].Resize(r, 2)
    
22.         For i = 1 To UBound(arr)
    
23.             If arr(i, 1) = Empty And arr(i, 2) <> Empty Then
    
24.                 arr(i, 1) = arr(i - 1, 1)
    
25.             End If
    
26.             s = arr(i, 2)
    
27.             d(s) = arr(i, 1)
    
28.         Next
    
29.         .[a1].Resize(r, 2) = arr
    
30.         r = .Cells(Rows.Count, "i").End(3).Row
    
31.         For i = 1 To r
    
32.             s = .Cells(i, "i")
    
33.             If d.exists(s) Then
    
34.                 .Cells(i, "h") = d(s)
    
35.             End If
    
36.         Next
    
37.     End With
    
38.     Set d = Nothing
    
39.     Application.ScreenUpdating = True
    
40.     MsgBox "汇总完毕!"
    
41. End Sub
    

复制代码

prowl

longwin 发表于 2024-6-18 22:09
请测试.......

感谢感谢帮助

prowl

ykcbf1100 发表于 2024-6-18 22:22
附件供参考。。。

谢谢老师提供帮助