求高手帮我也写个“多个表的成绩汇总到一个表中'代码

lsc900707

如何把“成绩”簿里各表的成绩汇总到一个表中？曾经试过几个相类似的程序，但在我的“.xlsm"文件下运行有问题，求高手帮我也写个“多个表的成绩汇总到一个表中'代码。谢了。

蓝桥玄霜

请见代码。

lsc900707

蓝桥玄霜 发表于 2016-4-30 17:12
请见代码。

感谢蓝版主！祝五一节快乐！

lsc900707

lsc900707 发表于 2016-4-30 17:31
感谢蓝版主！祝五一节快乐！

蓝版主，经测试发现：C列以后要加上科目名。现在G列的数据残缺不全（详见附件）。麻烦你再修改一下！

蓝桥玄霜

1. Sub lqxs()
   
2.     Dim Arr, myPath$, myName$, Brr, i&, j&, aa, ii&
   
3.     Dim x$, y$, k, t, kk, tt, bb
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Application.ScreenUpdating = False
   
6.     Sheet1.Activate
   
7.     Cells.ClearContents
   
8.     myPath = ThisWorkbook.Path & "\成绩"
   
9.     myName = Dir(myPath & "*.xlsx")
   
10.     Do While myName <> ""
    
11.         With GetObject(myPath & myName)
    
12.             Arr = .Sheets(1).Range("A1").CurrentRegion
    
13.             For i = 2 To UBound(Arr)
    
14.                 x = Arr(i, 1) & "," & Arr(i, 2): y = Arr(1, 3)
    
15.                 If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary")
    
16.                 d(x)(y) = Arr(i, 3)
    
17.             Next
    
18.             .Close False
    
19.         End With
    
20.         myName = Dir
    
21.     Loop
    
22.     k = d.keys: t = d.items
    
23.     ReDim Brr(1 To d.Count + 1, 1 To 20)
    
24.     Brr(1, 1) = "考号": Brr(1, 2) = "姓名"
    
25.     For i = 0 To UBound(k)
    
26.         kk = t(i).keys: tt = t(i).items
    
27.         bb = Split(k(i), ",")
    
28.         For ii = 0 To UBound(kk)
    
29.             Brr(i + 2, 1) = bb(0): Brr(i + 2, 2) = bb(1): Brr(i + 2, ii + 3) = tt(ii)
    
30.             If Brr(1, ii + 3) = "" Then Brr(1, ii + 3) = kk(ii)
    
31.         Next
    
32.     Next
    
33.     [a1].Resize(UBound(Brr), UBound(Brr, 2)) = Brr
    
34.     Application.ScreenUpdating = True
    
35. End Sub
    
36. 
    

复制代码

lsc900707

谢蓝版主的辛勤劳动！我在各个成绩工作表名前面加个序号，汇总后就是我要的顺序了。此问题完美解决！

Albert128

蓝桥玄霜 发表于 2016-5-2 16:11

蓝版运用字典到了登峰造极,本人也拜读<常见字典用法集锦及代码详解>还是对字典没学不好.

对于本题没看到向字典d写入内容哪来的k=d.Keys  : t=d.items
另,d与d(x)本人理解为是不同的字典对象,
本人愚钝,望老师指点.

蓝桥玄霜

Albert128 发表于 2016-5-2 18:32
蓝版运用字典到了登峰造极,本人也拜读还是对字典没学不好.

对于本题没看到向字典d写入内容哪来的k=d.K ...

第15、16句就已经写入一级字典d和二级字典d(x)了。
最有效的学习方法是在实战中学习，多做做就会逐步理解。

Albert128

蓝桥玄霜 发表于 2016-5-3 09:57
第15、16句就已经写入一级字典d和二级字典d(x)了。
最有效的学习方法是在实战中学习，多做做就会逐步理 ...

谢谢老师的回复,
[a2].Resize(d.Count, 1) = Application.Transpose(k)这样就可以看到了K相应的值,而
[b2].Resize(d.Count, 1) = Application.Transpose(t)为什么就提示错误?

蓝桥玄霜

Albert128 发表于 2016-5-3 22:04
谢谢老师的回复,
[a2].Resize(d.Count, 1) = Application.Transpose(k)这样就可以看到了K相应的值,而
. ...

本例是有二级字典的，所以这里的t不是单一的一维数组，而是每一个t(i)都是一个数组，不能用
[b2].Resize(d.Count, 1) = Application.Transpose(t)