- Foxtable(狐表) (http://foxtable.net/bbs/index.asp)
-- 专家坐堂 (http://foxtable.net/bbs/list.asp?boardid=2)
---- [求助]想解决EXCEL表双向导入问题，但怎么总是导入不成功，请老师指点？ (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=108078)
-- 发布时间：2017/10/16 0:56:00
-- [求助]想解决EXCEL表双向导入问题，但怎么总是导入不成功，请老师指点？
[求助]想解决EXCEL表双向导入问题，但怎么总是导入不成功，请老师指点？
| 下载信息 [文件大小： 下载次数： ] | |
 点击浏览该文件:excel表格双向导入问题.rar |
-- 发布时间：2017/10/16 9:09:00
--
Dim js1 As Integer = Tables("成绩台帐").Rows.Count
Forms("主界面").Open()
MainTable = Tables("主界面")
Dim dlg As new OpenFileDialog
dlg.Filter= "Excel文件|*.xls"
If dlg.ShowDialog = DialogResult.OK Then
application.DoEvents
Dim book As new XLS.Book(dlg.FileName)
Dim sheet1 As XLS.Sheet = book.Sheets(0)
Dim bdm,bmc1,bmc,gzh,nd,zy,cc,xf,kcxz,kcid,kcmc,xh,fs,bx,dg As String
StatusBar.Message1= "正在导入数据,请稍候"
application.DoEvents
If sheet1(1,0).text <> "模块" Then
MessageBox.Show("您的数据源不符合国家开放大学报表平台的数据格式,不能导入学生信息表数据!", "提示")
Else
DataTables("成绩台帐").StopRedraw
For i As Integer = 0 To sheet1.Rows.count -1
If sheet1(0,0).text.length >= 4 Then
bdm = sheet1(0,0).text.SubString(4,15)
Dim sts() As String = sheet1(0,0).Text.Split(":")
Dim sts1() As String = sts(2).Split("立")
bmc1 = sts1(0).SubString(0, sts1(0).Length-5)
bmc = bmc1.replace(" ","")
nd = sts1(1).SubString(3,7)
Dim sts2() As String = sts1(1).Split(")")
Dim sts3() As String = sts2(1).Split("-")
zy = sts3(0)
Dim sts4() As String = sts3(2).Split(" ")
cc = sts4(0)
gzh = sts(3).SubString(0, 15)
If sheet1(i,0).value = "课程id" Then
msgbox(2)
dg = i
For x As Integer = 3 To 35
If sheet1(dg,x).value.length = 5 Then
Dim ksds As DataRow = DataTables("成绩台帐").AddNew()
ksds("班代码") = bdm
ksds("班名称") = bmc
ksds("规则号") = gzh
ksds("年度") = nd
ksds("专业") = zy
ksds("层次") = cc
Dim sts6() As String = sheet1(dg-3,x).Text.Split(".")
ksds("学分") = sts6(0)
ksds("课程性质") = sheet1(dg-2,x).text
ksds("课程ID") = sheet1(dg,x).text
ksds("课程名程") = sheet1(dg+1,x).text
ksds("考试单位") = sheet1(dg-1,x).text
If sheet1(i,x).text.IndexOf("/") >= 0 Then
Dim sts7() As String = sheet1(i,x).Text.Split("/")
If sts7(0) <> Nothing Then
ksds("分数") = sts7(0)
Else
ksds("分数") = sts7(1)
End If
End If
End If
Next
End If
End If
Next
End If
application.DoEvents
DataTables("成绩台帐").ResumeRedraw
End If
Tables("成绩台帐").sort = "班代码,学号,课程ID"
Dim js2 As Integer = Tables("成绩台帐").Rows.Count
Dim js3 As Integer = js2 - js1
StatusBar.Message1= "祝贺您!本次共成功导入" & js3 & "科次!"
MessageBox.Show("祝贺您!本次共成功导入" & js3 & "科次!")
Tables("成绩台帐").filter = ""
-- 发布时间：2017/10/16 11:26:00
--
有点甜老师：怎么没导入分数和学号？
-- 发布时间：2017/10/16 12:13:00
--
Dim js1 As Integer = Tables("成绩台帐").Rows.Count
Forms("主界面").Open()
MainTable = Tables("主界面")
Dim dlg As new OpenFileDialog
dlg.Filter= "Excel文件|*.xls"
If dlg.ShowDialog = DialogResult.OK Then
application.DoEvents
Dim book As new XLS.Book(dlg.FileName)
Dim sheet1 As XLS.Sheet = book.Sheets(0)
Dim bdm,bmc1,bmc,gzh,nd,zy,cc,xf,kcxz,kcid,kcmc,xh,fs,bx,dg As String
StatusBar.Message1= "正在导入数据,请稍候"
application.DoEvents
If sheet1(1,0).text <> "模块" Then
MessageBox.Show("您的数据源不符合国家开放大学报表平台的数据格式,不能导入学生信息表数据!", "提示")
Else
DataTables("成绩台帐").StopRedraw
For i As Integer = 0 To sheet1.Rows.count -1
If sheet1(0,0).text.length >= 4 Then
bdm = sheet1(0,0).text.SubString(4,15)
Dim sts() As String = sheet1(0,0).Text.Split(":")
Dim sts1() As String = sts(2).Split("立")
bmc1 = sts1(0).SubString(0, sts1(0).Length-5)
bmc = bmc1.replace(" ","")
nd = sts1(1).SubString(3,7)
Dim sts2() As String = sts1(1).Split(")")
Dim sts3() As String = sts2(1).Split("-")
zy = sts3(0)
Dim sts4() As String = sts3(2).Split(" ")
cc = sts4(0)
gzh = sts(3).SubString(0, 15)
If sheet1(i,0).value = "课程id" Then
dg = i
For x As Integer = 3 To 35
If sheet1(dg,x).value.length = 5 Then
For j As Integer = i+2 To sheet1.rows.count-1
If sheet1(j,0).text.length > 20 Then Exit For
Dim ksds As DataRow = DataTables("成绩台帐").AddNew()
ksds("班代码") = bdm
ksds("班名称") = bmc
ksds("规则号") = gzh
ksds("年度") = nd
ksds("专业") = zy
ksds("层次") = cc
Dim sts6() As String = sheet1(dg-3,x).Text.Split(".")
ksds("学分") = sts6(0)
ksds("课程性质") = sheet1(dg-2,x).text
ksds("课程ID") = sheet1(dg,x).text
ksds("课程名程") = sheet1(dg+1,x).text
ksds("考试单位") = sheet1(dg-1,x).text
ksds("考试单位") = sheet1(j,1).text
If sheet1(j,x).text.IndexOf("/") >= 0 Then
Dim sts7() As String = sheet1(j,x).Text.Split("/")
If sts7(0) <> Nothing Then
ksds("分数") = sts7(0)
Else
ksds("分数") = sts7(1)
End If
End If
Next
End If
Next
End If
End If
Next
End If
application.DoEvents
DataTables("成绩台帐").ResumeRedraw
End If
Tables("成绩台帐").sort = "班代码,学号,课程ID"
Dim js2 As Integer = Tables("成绩台帐").Rows.Count
Dim js3 As Integer = js2 - js1
StatusBar.Message1= "祝贺您!本次共成功导入" & js3 & "科次!"
MessageBox.Show("祝贺您!本次共成功导入" & js3 & "科次!")
Tables("成绩台帐").filter = ""