[已解决]不重不漏的查找统计文件夹下所有表格中人情况

嘻嘻哈哈大傻瓜

有十多个表， 内容是不合格的学生名单，大部分是重复的，比如张三在所有表中都有，但是李四只在其中3个中存在。A表有100个学生，B表有30个学生，但是B表中有29个学生A表重复。那么最后统计应该有101个学生名单。
每个表都有相同的2列标题行 学籍号 学生姓名

其他列标题各不相同。

想另作个表格找出所有不合格学生的学籍号和学生姓名，此学生不合格所在的表名称。

最好做成链接，点击表明自动打开相应文件。
目的在于不重不漏的，主要是不漏的找出所有学生的不合格情况进行比对。
O(∩_∩)O谢谢！ 高三平台不达标信息导出.rar (67.09 KB, 下载次数: 4)

2015-2-27 11:24 上传

点击文件名下载附件

统计表.rar (3.26 KB, 下载次数: 3)

2015-2-27 11:33 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

dsmch

2015-2-27 15:20

…………

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, d, mypath$$, wj$$, i&, s&, n%
   
3. Set d = CreateObject("scripting.dictionary")
   
4. ReDim brr(1 To 20000, 1 To 200)
   
5. mypath = ThisWorkbook.Path & "\数据源"
   
6. wj = Dir(mypath & "*.XLS")
   
7. n = 2
   
8. Application.ScreenUpdating = False
   
9. Do While wj <> ""
   
10.     n = n + 1
    
11.     With GetObject(mypath & wj)
    
12.         gzb = Split(.Name, ".XLS")(0)
    
13.         arr = .Sheets(1).Range("a1").CurrentRegion
    
14.         For i = 2 To UBound(arr)
    
15.             If Not d.exists(arr(i, 1)) Then
    
16.                 s = s + 1
    
17.                 d(arr(i, 1)) = s
    
18.                 brr(s, 1) = arr(i, 1)
    
19.                 brr(s, 2) = arr(i, 2)
    
20.                 brr(s, n) = gzb
    
21.             Else
    
22.                 brr(d(arr(i, 1)), n) = gzb
    
23.             End If
    
24.         Next
    
25.         .Close 0
    
26.     End With
    
27.     wj = Dir
    
28. Loop
    
29. Range("a2").Resize(s, n) = brr
    
30. Columns.AutoFit
    
31. Application.ScreenUpdating = True
    
32. End Sub

复制代码

dsmch

…………

嘻嘻哈哈大傻瓜

dsmch 发表于 2015-2-27 15:20
…………

谢谢！非常感谢！