专家坐堂-代码问题Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.com/bbs/index.asp)
--  专家坐堂  (http://foxtable.com/bbs/list.asp?boardid=2)
----  代码问题  (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=92770)

--  作者：刘林
--  发布时间：2016/11/12 13:44:00
--  代码问题

Dim dlg As new OpenFileDialog
dlg.Filter = "Excel|*.xls;*.xlsx"
If dlg.ShowDialog = DialogResult.OK Then
Dim Book As New XLS.Book(dlg.FileName)
Dim Sheet As XLS.Sheet = Book.Sheets(0)
Dim bmh As Integer
Dim ksh As Integer
Dim xm As Integer
Dim sw As Integer
Dim dl As Integer
Dim njdm As Integer
Dim bj As Integer
Dim xxmc As Integer
For i As Integer = 0 To sheet.Cols.count -1
If sheet(0,i).value = "报名号"
bmh =i
End If
If sheet(0,i).value = "考试号"
ksh = i
End If
If sheet(0,i).value = "xm"
xm = i
End If
If sheet(0,i).value ="生物"
sw = i
End If
If sheet(0,i).value ="地理"
dl = i
End If
If sheet(0,i).value ="年级代码"
njdm = i
End If
If sheet(0,i).value ="班级"
bj = i
End If
If sheet(0,i).value = "学校名称"
xxmc = i
End If
Next
Tables("成绩").StopRedraw()
For n As Integer = 1 To Sheet.Rows.Count -1
Dim bmh1 As String = sheet(n,bmh).value.replace(" ","").replace(chr(9),"")
Dim xm1 As String = sheet(n,xm).value.replace(" ","").replace(chr(9),"")
Dim bj1 As String = sheet(n,bj).value.replace(" ","").replace(chr(9),"")
Dim njdm1 As String = sheet(n,njdm).value.replace(" ","").replace(chr(9),"")
Dim xxmc1 As String = sheet(n,xxmc).value.replace(" ","").replace(chr(9),"")
Dim dr As DataRow = DataTables("成绩").sqlFind("单位名称 = \'" & xxmc1 & "\'and 姓名 = \'" & xm1 & "\'And 考试名称 = \'" & e.form.Controls("ComboBox2").value & "\' And 年级代码 = \'" & njdm1 & "\' And 班级 = \'" & bj1 & "\'")
\' If dr Is Nothing Then \'如果不存在同考号的行
\' dr = DataTables("学生信息").AddNew()
\' End If
For m As Integer = 0 To sheet.Cols.count -1
Select Case sheet(0,m).value
Case "生物"
dr("生物_A") = sheet(n,m).value
Case "地理"
dr("地理_A") = sheet(n,m).value
Case "报名号","考试号"
dr(sheet(0,m).value) = Sheet(n,m).Value.replace(" ","").replace(chr(9),"")
End Select

Next
Next
Tables("成绩").ResumeRedraw()
DataTables("成绩").save()
End
老师，我有成绩表，另有一个生物地理EXCL表结构如下

报名号考试号姓名生物地理年级代码班级学校名称

175902137001 170213604 曹洪图 16 39 14 03 内江市东兴区石子镇中心学校

想按年级，班级，学校名称，考试名称，姓名，将生物，地理成绩导入到生物_A,地理_B,现写出上面代码不够简洁，另外还有错误提示：未设置对象变量或 With 块变量。请问错在哪里，如何更简洁，谢谢

--  作者：有点蓝
--  发布时间：2016/11/12 15:11:00
--

Dim dlg As new OpenFileDialog
dlg.Filter = "Excel|*.xls;*.xlsx"
If dlg.ShowDialog = DialogResult.OK Then
Dim Book As New XLS.Book(dlg.FileName)
Dim Sheet As XLS.Sheet = Book.Sheets(0)
Dim cls() As String = { "报名号","考试号","姓名","生物","地理","年级代码","班级","学校名称" }
Dim dict As new Dictionary(of String,Integer)
For i As Integer = 0 To cls.Length -1
dict.Add(cls(i),0)
Next
For i As Integer = 0 To sheet.Cols.count -1
If dict.ContainsKey(sheet(0,i).value) Then
dict(sheet(0,i).value) = i
End If
Next
Tables("成绩").StopRedraw()
For n As Integer = 1 To Sheet.Rows.Count -1

Dim bmh1 As String = sheet(n,dict("报名号")).value.replace(" ","").replace(chr(9),"")
Dim xm1 As String = sheet(n,dict("姓名")).value.replace(" ","").replace(chr(9),"")
Dim bj1 As String = sheet(n,dict("班级")).value.replace(" ","").replace(chr(9),"")
Dim njdm1 As String = sheet(n,dict("年级代码")).value.replace(" ","").replace(chr(9),"")
Dim xxmc1 As String = sheet(n,dict("学校名称")).value.replace(" ","").replace(chr(9),"")
Dim dr As DataRow = DataTables("成绩").sqlFind("单位名称 = \'" & xxmc1 & "\'and 姓名 = \'" & xm1 & "\'And 考试名称 = \'" & "16秋10月考" & "\' And 年级代码 = \'" & njdm1 & "\' And 班级 = \'" & bj1 & "\'")

If dr Is Nothing Then \'如果不存在同考号的行
dr = DataTables("成绩").AddNew()
End If
dr("生物_A") = val(sheet(n,dict("生物")).value)
dr("地理_A") = val(sheet(n,dict("地理")).value)
\'dr("报名号") = sheet(n,dict("报名号")).value.replace(" ","").replace(chr(9),"")
\'dr("考试号") = sheet(n,dict("考试号")).value.replace(" ","").replace(chr(9),"")
dr.save
Next
Tables("成绩").ResumeRedraw()
\'DataTables("成绩").save()
End If

--  作者：刘林
--  发布时间：2016/11/12 15:17:00
--

Dim g As New GroupTableBuilder("统计表1", DataTables("成绩"))
Dim dt1 As Table = Tables("后台统计_table2")
g.Groups.AddDef("考试名称")
g.Groups.AddDef("单位名称")
g.Groups.AddDef("年级代码")
g.Groups.AddDef("班级")
g.Totals.AddDef("姓名",AggregateEnum.Count,"参考人数")
g.Totals.AddDef("语文_A",AggregateEnum.Average,"语文平均_A")
g.Totals.AddDef("语文_B",AggregateEnum.Average,"语文平均_B")
g.Totals.AddDef("数学_A",AggregateEnum.Average,"数学平均_A")
g.Totals.AddDef("数学_B",AggregateEnum.Average,"数学平均_B")
g.Totals.AddDef("英语_A",AggregateEnum.Average,"英语平均_A")
g.Totals.AddDef("英语_B",AggregateEnum.Average,"英语平均_B")
g.Totals.AddDef("政治_A",AggregateEnum.Average,"政治平均_A")
g.Totals.AddDef("政治_B",AggregateEnum.Average,"政治平均_B")
g.Totals.AddDef("历史_A",AggregateEnum.Average,"历史平均_A")
g.Totals.AddDef("历史_B",AggregateEnum.Average,"历史平均_B")
g.Totals.AddDef("物理_A",AggregateEnum.Average,"物理平均_A")
g.Totals.AddDef("物理_B",AggregateEnum.Average,"物理平均_B")
g.Totals.AddDef("化学_A",AggregateEnum.Average,"化学平均_A")
g.Totals.AddDef("化学_B",AggregateEnum.Average,"化学平均_B")
g.Totals.AddDef("生物_A",AggregateEnum.Average,"生物平均_A")
g.Totals.AddDef("生物_B",AggregateEnum.Average,"生物平均_B")
g.Totals.AddDef("地理_A",AggregateEnum.Average,"地理平均_A")
g.Totals.AddDef("地理_B",AggregateEnum.Average,"地理平均_B")
g.Totals.AddDef("体育",AggregateEnum.Average,"体育平均")
g.Totals.AddDef("物理实验",AggregateEnum.Average,"物理实验")
g.Totals.AddDef("化学实验",AggregateEnum.Average,"化学实验")
g.Totals.AddDef("总分",AggregateEnum.Average,"总分平均")
g.Totals.AddDef("折总",AggregateEnum.Average,"折总平均")
g.Totals.AddDef("总分",AggregateEnum.Average,"总分平均")
g.Totals.AddExp("300分以下","iif(分数 < 300,1,0)")

g.FromServer = True
dt1.DataSource = g.BuildDataSource()
dt1.DataTable.DataCols.Add("班级排名",Gettype(Integer))

\'\'********"\'And [班级] = \'" & ary1(2) & And [单位名称] = \'" & ary1(1) & "\'
Dim Arys1 As List(Of String()) = dt1.DataTable.GetValues("考试名称|单位名称|年级代码")
For Each Ary1 As String() In Arys1
Dim drs As List(Of DataRow) = dt1.DataTable.Select("[考试名称] = \'" & ary1(0) & "\'and [年级代码] =\'" & ary1(2) & "\'", "折总平均 DESC")
For m As Integer = 0 To drs.Count - 1 \'遍历所有行
If m > 0 AndAlso drs(m)("折总平均") = drs(m-1)("折总平均") Then \'如果总分和上一行相同
drs(m)("班级排名") = drs(m-1)("班级排名") \'则排名等于上一行
Else
drs(m)("班级排名") = m + 1 \'设置排名
End If
Next
Next
\'\'********
dt1.SetColVisibleWidth("考试名称|80|单位名称|160|年级代码|40|班级|30|参考人数|30|语文平均_A|40|语文平均_B|40|数学平均_A|30|数学平均_B|40|英语平均_A|40|英语平均_B|40|政治平均_A|40|政治平均_B|40|历史平均_A|40|历史平均_B|40|物理平均_A|40|物理平均_B|40|化学平均_A|40|化学平均_B|40|生物平均_A|40|生物平均_B|40|地理平均_A|40|地理平均_B|40|体育平均|40|物理实验|40|化学实验|40|总分平均|70|折总平均|70|班级排名|40|300分以下|20")
Dim btn2 As WinForm.Button = e.Form.Controls("Button2")
btn2.PerformClick()

老师还有一个问题，上面后台统计代码还运行是对的，我还想增加按总分分段统计加在后面，但无反应，请问应怎么样改

--  作者：有点蓝
--  发布时间：2016/11/12 15:34:00
--
g.Totals.AddExp("300分以下","iif(总分 < 300,1,0)")

--  作者：刘林
--  发布时间：2016/11/12 15:41:00
--

g.Totals.AddExp("300分以下","iif(总分 < 300,1,0)")
哦，不好意思，没改到字段名，但是现在改了还是不会在窗口表格中显示呢

--  作者：有点蓝
--  发布时间：2016/11/12 15:49:00
--
改成sqlGroupTableBuilder试试

Dim g As New SqlGroupTableBuilder("统计表1", "成绩")

--  作者：刘林
--  发布时间：2016/11/12 16:06:00
--
老师，上面2楼代码出现，全部为新增记录，且我是用EXCL的几个字段去对应成绩表中字段（如报名考导进了生物_A），找到了才将生物，地理成绩导进去，没找到也不新增，因为之前考了有生物、地理成绩的学生现在没在读了。请老师看下，谢谢

--  作者：有点蓝
--  发布时间：2016/11/12 16:08:00
--
上例子

--  作者：刘林
--  发布时间：2016/11/12 17:31:00
--

下载信息  [文件大小：   下载次数： ]
点击浏览该文件:管理项目11.zip

请老师，看下如何解决以上两个问题，EXCL文件在压缩包里

--  作者：有点色
--  发布时间：2016/11/13 10:27:00
--
        Dim dr As DataRow = DataTables("成绩").Find("单位名称 = \'" & xxmc1 & "\'and 姓名 = \'" & xm1 & "\'And 考试名称 = \'" & e.form.Controls("ComboBox2").value & "\' And 年级代码 = \'" & njdm1 & "\' And 班级 = \'" & bj1 & "\'")
        If dr Is Nothing Then \'如果不存在同考号的行
            dr = DataTables("学生信息").AddNew()
        End If