不同学校各科成绩合并

小鲨鱼

目前有多个学校的各科成绩，分别在ＥＸＣＥＬ表中不同的ＳＨＥＥＴ中，现在需要合并在sheet1中。


同一学校可以依据考号来合，但不同学校的考号可能相同，主要思路：先找到同一学校，再对比考号和姓名，再把这几科成绩合在一起。



有一个问题是不同科目参加的人数不同，有个别同学的个别科目缺考，又没有全部的名单，只能先合出所有的名单。

实际数据各科有近２万人，有七科成绩，因为文件太大，所以择了一小部分做个示例。
麻烦大家给想个公式。

魚。。

这个数据量不建议用公式

cyh3230

这个用 查询 弄了下, 效果感觉应该还可以

但最好是用 Access 来弄, 应该比 Excel 要好很多

13570449347

看看这样行不行咯

小鲨鱼

13570449347 发表于 2024-5-15 09:48
看看这样行不行咯

这个不太合适

cnmlgb9998

PQ解决方案，是不是这样？？？？？？

cnmlgb9998

PQ方案 ，完善了一下代码。所有的记录都包括在内，不会落下一条。。。。。。

3190496160

Sub 成绩合并()
Application.ScreenUpdating = False
Dim ar As Variant
Dim br()
Dim i As Long, r As Long, rs As Long
Dim sh As Worksheet
Dim d As Object
Set d = CreateObject("scripting.dictionary")
ReDim br(1 To 100000, 1 To 20)
rr = Array("学校", "班级", "考号", "姓名", "学号")
k = 1
For j = 0 To UBound(rr)
    br(k, j + 1) = rr(j)
Next j
y = 5
For Each sh In Sheets
    If sh.Index > 1 Then
        r = sh.Cells(Rows.Count, 1).End(xlUp).Row
        If r > 1 Then
            ar = sh.Range("a1:f" & r)
            y = y + 1
            br(1, y) = ar(1, 6)
            For i = 2 To UBound(ar)
                If ar(i, 1) <> "" Then
                    zd = ar(i, 1) & "|" & ar(i, 2) & "|" & ar(i, 3) & "|" & ar(i, 4) & "|" & ar(i, 5)
                    t = d(zd)
                    If t = "" Then
                        k = k + 1
                        d(zd) = k
                        t = k
                        For j = 1 To 5
                            br(k, j) = ar(i, j)
                        Next j
                    End If
                    br(t, y) = ar(i, 6)
                End If
            Next i
        End If
    End If
Next sh
If k = 1 Then MsgBox "没有需要汇总的成绩表！": End
With Sheets("sheet1")
    .UsedRange.Borders.LineStyle = 0
    .UsedRange = Empty
    .[a1].Resize(k, y) = br
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

这么大的数据量，就别想公式 了，用代码吧，十多万行数据，应该不是问题的，

3190496160

成绩合并样本.rar (32.95 KB, 下载次数: 9)

2024-5-15 11:24 上传

点击文件名下载附件