细节自己调整
Dim str,str1 As String
str = forms("统计").Controls("ComboBox1").value
str1 = forms("统计").Controls("ComboBox2").value
If str Is Nothing Then
MessageBox.Show("请选择上一期的比较参数","中止操作",MessageBoxButtons.OK,MessageBoxIcon.Exclamation)
ElseIf str1 Is Nothing
MessageBox.Show("请选择下一期的比较参数","中止操作",MessageBoxButtons.OK,MessageBoxIcon.Exclamation)
ElseIf str = str1
MessageBox.Show("比较的两期数据不能相同","中止操作",MessageBoxButtons.OK,MessageBoxIcon.Exclamation)
Else
forms("统计").Controls("Label3").text="正在分析,请稍候..."
Application.Doevents
Dim Time,Time1 As Date
Time = Date.now
Vars("qs") = str
'加载指定期数的数据,生成成绩转置
Dim z As New CrossTableBuilder("成绩转置", DataTables("成绩登记表"))
z.HGroups.AddDef("考试期数")
z.HGroups.AddDef("班级")
z.HGroups.AddDef("学号")
z.HGroups.AddDef("姓名")
z.VGroups.AddDef("课程名称")
z.Totals.AddDef("分数", "分数")
z.HorizontalTotal = True
z.Build()
MainTable = Tables("成绩转置")
Tables("成绩转置").grid.Cols("合计").caption = "总分"
'生成成绩排名表
Dim g As New CrossTableBuilder("成绩排名表", DataTables("成绩登记表"))
g.HGroups.AddDef("考试期数")
g.HGroups.AddDef("班级")
g.HGroups.AddDef("学号")
g.HGroups.AddDef("姓名")
g.VGroups.AddDef("课程名称")
g.Totals.AddDef("分数", "分数")
g.Totals.AddDef("排名")
g.HorizontalTotal = True
g.Build()
MainTable = Tables("成绩排名表")
'获得所有班级名称,保存在集合中
Dim bjs As List(Of String()) = DataTables("成绩排名表").GetValues("考试期数|班级")
DataTables("成绩排名表").StopRedraw
For Each bj As String() In bjs
'获得该班级的全部行,按总分降序排序
For Each c As Col In Tables("成绩排名表").Cols
If c.Caption.Contains("分数") Then
Dim fs As String = "分数_" & c.name.Split("_")(1)
Dim pm As String = "排名_" & c.name.Split("_")(1)
If c.Caption.Contains("合计") Then
fs = "合计_分数"
pm = "合计_排名"
End If
Dim drs As List(Of DataRow) = DataTables("成绩排名表").Select("考试期数 = '" & bj(0) & "' and [班级] = '" & bj(1) & "'", fs & " DESC")
For n As Integer = 0 To drs.Count - 1 '遍历所有行
If n > 0 AndAlso drs(n)(fs) = drs(n-1)(fs) Then '如果总分和上一行相同
drs(n)(pm) = drs(n-1)(pm) '则排名等于上一行
Else
drs(n)(pm) = n + 1 '设置排名
End If
Next
End If
Next
Next
DataTables("成绩排名表").ResumeRedraw
Tables("统计_Table2").DataSource = DataTables("成绩排名表")
''下面对成绩排名表中进行排名
'Dim pm As List(Of String) = Tables("成绩排名").DataTable.GetUniqueValues("","期数")
'Dim pmc As Integer
'Dim ColNames() As String = {"语文","数学","英语","化学","物理","总分"}
'Dim TotalName As String
'For Each ColName As String In ColNames
'For i As Integer = 0 To pm.Count -1
'If pm(i) = "" Then
'Continue For
'End If
'Dim drs As List(Of DataRow) = Tables("成绩排名").DataTable.Select("[期数] = " & pm(i), ColName & " DESC")
'pmc = 0
'TotalName = ColName & "排名"
'For n As Integer = 0 To drs.Count - 1
'pmc = pmc +1
'If n > 0 AndAlso drs(n)(ColName ) = drs(n-1)(ColName) Then
'drs(n)(TotalName ) = drs(n-1)(TotalName )
'Else
'drs(n)(TotalName ) = pmc
'End If
'Next
'Next
'Next
'Tables("成绩排名").Sort = "总分 DESC"
Dim dic1 As new Dictionary(of String, String)
Dim scols As String = ""
Dim dcols As String = ""
For Each c As Col In Tables("成绩转置").cols
dic1.add(c.caption, c.name)
dcols &= c.caption & ","
Next
Dim dic As new Dictionary(of String, String)
For Each c As Col In Tables("成绩排名表").cols
dic.add(c.caption, c.name)
If c.Caption.Contains("分数") = False Then
scols &= c.name & ","
End If
Next
Dim dtb As New DataTableBuilder("排名升降分析")
For Each key As String In dic1.Keys
dtb.AddDef(key, Gettype(String))
Next
dtb.build
DataTables("排名升降分析").DataRows.Clear()
'CurrentTable.Focus() '移动焦点到Table
'msgbox(scols & " " & dcols)
Dim h As New Filler
h.SourceTable = DataTables("成绩排名表")
h.SourceCols = scols.trim(",") '"期数,班级,学号,姓名,语文排名,数学排名,英语排名,物理排名,化学排名,总分排名"
h.DataTable = DataTables("排名升降分析")
h.DataCols = dcols.trim(",") '"期数,班级,学号,姓名,语文,数学,英语,物理,化学,总分"
h.Filter = "[考试期数] = '"& str1 & "'"
h.ExcludeExistValue = True
h.Fill
'以下进行排名分析,建立升降分析表
'DataTables("排名升降分析").StopRedraw
Dim dt As Table = Tables("排名升降分析")
Dim dt1 As DataTable = DataTables("成绩排名表")
For Each Name As String In dic.keys
If name.contains("排名") Then
Dim ColName1 As String = dic(name)
name = name.replace("_排名", "")
For i As Integer = 0 To dt.rows.count -1
Dim Value As Integer
output.show(i)
Value = dt1.Compute("sum(" & ColName1 & ")","[学号] = '" & dt.Rows(i)("学号") & "' And [考试期数] = '" & vars("qs") & "'" )
Dim n As Integer = dt.Rows(i)(Name) - Value
Dim Symbol As String
If n = 0 Then '如果等于下面的不同值,赋于不同的字符
Symbol = "←"
ElseIf n < 0 Then
Symbol = "↑"
Else
Symbol = "↓"
End If
dt.Rows(i)(Name) = Symbol & Math.abs(dt.Rows(i)(Name) - Value ) & "(" & dt.Rows(i)(Name) & "/" & Value & ")"
Next
End If
Next
'Time1 = Date.Now
'forms("统计").Controls("Label3").text="耗时 " & (Time1-Time).TotalSeconds & " 秒"
End If
加好友 
发短信
Post By：2018/11/2 9:04:00 [显示全部帖子]
