清华大佬耗费三个月吐血整理的几百G的资源，免费分享！....>>>

Sub tt()
Dim kcmc As String '课程名称
Dim n As Integer
n = 0 '成绩行数
Dim rs As Integer
rs = 57 '班级人数

Dim i As Integer
Dim j As Integer '成绩表中课程所在列
j = 0

'专业名称
Dim zy As String
zy = "护理"

'专业方向
Dim fx As String
fx = "卫生技术"

'班级名称
Dim bj As String
bj = "高护0822"

'上传表格字段次序
'1专业名称
'2专业方向
'3班级名称'
'4学号'
'5姓名
'6课程代码
'7课程名称
'8开课学期
'9成绩
'10学分

For Each kc In Sheet1.Range("f1:f63")
kcmc = kc.Value


i = 1
For Each c In Sheet3.Range("d2:d1760")
    If c.Value = bj Then
        Sheet4.Cells(n + i, 1) = zy '1专业
        Sheet4.Cells(n + i, 2) = fx '2方向
        Sheet4.Cells(n + i, 3) = bj '3班级
        Sheet4.Cells(n + i, 4) = Sheet3.Cells(c.Row, 5) '4学号
        Sheet4.Cells(n + i, 5) = Sheet3.Cells(c.Row, 6) '5姓名
        i = i + 1
    End If
Next c


 '课程名称
For i = 1 To rs
    Sheet4.Cells(n + i, 6) = Sheet1.Cells(kc.Row, 5) '6课程代码
    Sheet4.Cells(n + i, 7) = Sheet1.Cells(kc.Row, 6) '7课程名称
    Sheet4.Cells(n + i, 8) = Sheet1.Cells(kc.Row, 14) '8开课学期
    Sheet4.Cells(n + i, 10) = Sheet1.Cells(kc.Row, 13) '10学分
Next i


'成绩
For Each mc In Sheet2.Range("a1:ar1")
    If mc.Value = kcmc Then
        j = mc.Column
    End If
Next mc

i = 1
For Each d In Sheet4.Range("e1:e57")
    For Each c In Sheet2.Range("b2:b58")
        If c.Value = d.Value Then
            Sheet4.Cells(n + i, 9) = Sheet2.Cells(c.Row, j) '9成绩
            i = i + 1
        End If
    Next c
Next d

n = n + rs

Next kc

End Sub