利用vba进行多学科成绩汇总

0536lzl

请问怎样通过vba把各个不同工作表中最后一列的成绩按照身份证号汇总到成绩汇总工作表中，并且每个学科分别一列。期待各位专家回答。谢谢了。

3190496160

Sub 汇总()
Application.ScreenUpdating = False
Dim ar As Variant, br As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("成绩汇总")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    y = .Cells(1, Columns.Count).End(xlToLeft).Column
    If r < 2 Or y < 7 Then MsgBox "请在成绩汇总中输入相关信息！": End
    .Range(.Cells(2, 7), .Cells(r + 1, y)) = Empty
    ar = .Range(.Cells(1, 1), .Cells(r, y))
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            d(Trim(ar(i, 1))) = i
        End If
    Next i
    For j = 7 To UBound(ar, 2)
        If Trim(ar(1, j)) <> "" Then
            d(Trim(ar(1, j))) = j
        End If
    Next j
    For Each sht In Worksheets
        If sht.Name <> "成绩汇总" Then
            rs = sht.Cells(Rows.Count, 1).End(xlUp).Row
            br = sht.Range("a2:h" & rs)
            lh = d(sht.Name)
            For i = 2 To UBound(br)
                xh = d(Trim(br(i, 1)))
                If xh <> "" And lh <> "" Then
                    ar(xh, lh) = br(i, 8)
                End If
            Next i
        End If
    Next sht
    .Range(.Cells(1, 1), .Cells(r, y)) = ar
End With
Set d = Nothing
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

成绩汇总.rar (257.5 KB, 下载次数: 7)

2023-1-11 09:41 上传

点击文件名下载附件

清风竹-

请看附件。

0536lzl

清风竹- 发表于 2023-1-11 10:15
请看附件。

太厉害了，非常感谢