同一学生多次成绩汇总

lcmphy · 发表于 2023-12-31 17:17

本帖最后由 lcmphy 于 2024-1-1 10:03 编辑

每次考试学生人数不完全相同，同一学生每次考试的学籍号、班级、姓名、性别信息等是固定的，其他信息是变动的。每次考试一个工作簿，把多次成绩放到同一个文件夹里面，在成绩汇总文件里面，通过设置参数，用VBA代码提取所有学生多次考试指定列的成绩信息。样本数据与效果见附件。谢谢

lcmphy · 发表于 2024-1-1 07:45

本帖最后由 lcmphy 于 2024-1-1 10:11 编辑

准确表述可能是工作簿合并，如果合并指定列内容不方便，直接一个学生一行，所有内容包括标题行都追加到后面更好，这样合并后，只要删除不需要的列就可以了。

ykcbf1100 · 发表于 2024-1-1 11:01

这个参数设置看不懂，暂时下不了手。

文件夹可以不设置，改为手动选择，由VBA来完成。

lcmphy · 发表于 2024-1-1 13:03

ykcbf1100 发表于 2024-1-1 11:01
这个参数设置看不懂，暂时下不了手。

文件夹可以不设置，改为手动选择，由VBA来完成。

设置参数麻烦，改为不需要设置参数。
每个成绩表的第3行与第4行为标题行，第5行开始为内容行，学籍号相同的是同一个学生，只占一行，直接把9月、10月多个工作簿合并到一个工作簿，不是往下追加，是往表格的右边依次追加。

ykcbf1100 · 发表于 2024-1-1 15:48

本帖最后由 ykcbf1100 于 2024-1-1 18:17 编辑

代码更新了

Sub ykcbf() '//2024.1.1
Dim fns As New Collection
Set Fso = CreateObject("scripting.filesystemobject")
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
Set sh = ThisWorkbook.Sheets("汇总表")
xx = [{"学籍号","班级","校名","性别"}]
xm = [{"分数","县名","校名","进步"}]
p = ThisWorkbook.Path & "\成绩"
Set ff = Fso.GetFolder(p)
Call GetFiles(ff, fns, Fso)
For Each k In fns
m = m + 1
sh.Cells(m, 1) = k(0)
sh.Cells(m, 2) = k(1)
sh.Cells(m, 3) = Val(k(1))
Next
sh.[a1].Resize(fns.Count, 3).Sort sh.[c1], 1
zrr = sh.[a1].Resize(fns.Count, 3)
c = 4
For y = 1 To UBound(zrr)
n = n + 1
Set Wb = Workbooks.Open(zrr(y, 1), 0)
With Wb.Sheets(1)
arr = .UsedRange
Wb.Close False
End With
For i = 5 To UBound(arr)
If arr(i, 1) <> Empty Then
s = CStr(arr(i, 1))
If Not d1.exists(s) Then
d1(s) = Array(CStr(arr(i, 1)), CStr(arr(i, 4)), arr(i, 6), arr(i, 7))
End If
s = CStr(arr(i, 1)) & "|" & n
If Not d.exists(s) Then
d(s) = Array(arr(i, 9), arr(i, 12), arr(i, 13), arr(i, 14), n)
End If
End If
Next
Next
t = d.items
With sh
.UsedRange.Clear
.[a1].Resize(1, 4) = xx
For x = 1 To n
.Cells(1, c + (x - 1) * 4 + 1).Resize(1, 4) = xm
Next
.Columns("A:B").NumberFormatLocal = "@"
.[a2].Resize(d1.Count, 4) = Application.Rept(d1.items, 1)
arr = .UsedRange
For i = 2 To UBound(arr)
For m = 1 To n
k = 0
For x = 1 To 4
k = c + (m - 1) * 4 + x
s = CStr(arr(i, 1)) & "|" & m
If d.exists(s) Then
arr(i, k) = d(s)(x - 1)
End If
Next
Next
Next
.Columns("A:B").NumberFormatLocal = "@"
With .UsedRange
.Value = arr
.Borders.LineStyle = 1
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End With
Set d = Nothing
Set d1 = Nothing
Application.ScreenUpdating = True
MsgBox "OK！"
End Sub
Function GetFiles(ff, fns, Fso)
For Each f In ff.Files
If f.Name Like "*.xls*" Then
fns.Add Array(f.Path, Fso.GetBaseName(f))
End If
Next
End Function

复制代码

一下。。。

复制代码

ykcbf1100 · 发表于 2024-1-1 15:49

本帖最后由 ykcbf1100 于 2024-1-1 18:16 编辑

lcmphy 发表于 2024-1-1 13:03
设置参数麻烦，改为不需要设置参数。
每个成绩表的第3行与第4行为标题行，第5行开始为内容行，学籍号相 ...

附件供参考。。。

lcmphy · 发表于 2024-1-1 17:08

ykcbf1100 发表于 2024-1-1 15:49
附件供参考。。。

非常感谢！如果所有学生每次都参考，能够很好的合并所有学生的成绩；10月成绩里面的李七，8月、9月缺考没成绩，汇总的时候汇总到8月对应的成绩下面去了，这个还可以完善一下么？

ykcbf1100 · 发表于 2024-1-1 18:07

lcmphy 发表于 2024-1-1 17:08
非常感谢！如果所有学生每次都参考，能够很好的合并所有学生的成绩；10月成绩里面的李七，8月、9月缺考没 ...

其实数据没有错，只是10月排在了前面了，正常情况下，10月比8月排在前面，排序就这样的。

ykcbf1100 · 发表于 2024-1-1 18:15

本帖最后由 ykcbf1100 于 2024-1-1 18:44 编辑

lcmphy 发表于 2024-1-1 17:08
非常感谢！如果所有学生每次都参考，能够很好的合并所有学生的成绩；10月成绩里面的李七，8月、9月缺考没 ...

改了一下，可以达到你的需求了。

lcmphy · 发表于 2024-1-1 18:27

ykcbf1100 发表于 2024-1-1 18:07
其实数据没有错，只是10月排在了前面了，正常情况下，10月比8月排在前面，排序就这样的。

是的，刚在学校测试发现没有任何问题，我想到应该是文件排序的先后，果然您就回复了。
测试了一下，只要修改标题名称与对应的数据列数1,4,6,7,9,12,13,14，改成其他需要的列数，就可以根据需要汇总其他列的数据。
非常感谢您的帮助！

		自动登录	找回密码
密码			免费注册

同一学生多次成绩汇总

评分

评分

评分