从多个表格中提取出有用数据做成新的表格代码,VB.Net代码库,德仔网

代码语言

代码分类

【VB.Net】从多个表格中提取出有用数据做成新的表格

作者:justaajoke / 发布于2013/11/28/ 1079

提取若干表格中有用数据,做成一个新的表格

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

试试其它关键字

　数据库链接　

同语言下

可能有用的

justaajoke贡献的其它代码(2)