从多个表格中提取出有用数据做成新的表格

以下代码由PHP站长网 52php.cn收集自互联网

现在PHP站长网小编把它分享给大家，仅供参考

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

以上内容由PHP站长网【52php.cn】收集整理供大家参考研究

如果以上内容对您有帮助，欢迎收藏、点赞、推荐、分享。

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!