- Foxtable(狐表) (http://foxtable.com/bbs/index.asp)
-- 专家坐堂 (http://foxtable.com/bbs/list.asp?boardid=2)
---- [求助]尾考室不大于5人，则加到上一考室，如何处理？ (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=170208)
-- 发布时间：2021/7/16 15:15:00
-- [求助]尾考室不大于5人，则加到上一考室，如何处理？
DataTables("成绩库").StopRedraw
Dim xuankes() As String = {"化","生","政","地"}
Dim Values() As String = {"考号"}
For Each Value As String In Values
Tables("成绩库").Cols(Value & "排序").Visible = True
Next
Tables("成绩库").Sort = "姓名"
For Each Value As String In Values
For Each xuanke As String In xuankes
For Each danwei As String In DataTables("成绩库").GetValues("单位", " ")
For Each nianji As String In DataTables("成绩库").GetValues("年级","单位 = \'" & danwei & "\'" )
For Each zuhe As String In DataTables("成绩库").GetValues("组合","年级 = \'" & nianji & "\'" )
Dim tj As String = value & "排序"
\'Dim tj5 As String = "序号"
Dim drs As List(Of DataRow) = DataTables("成绩库").Select("[年级] = \'" & nianji & "\'And [单位] = \'" & danwei & "\'", "" & value & "")
For n As Integer = 0 To drs.Count - 1 \'遍历所有行
drs(n)(tj) = n + 1 \'设置排序
drs(n)("考场号") = Math.Ceiling(drs(n)(tj)/40)
drs(n)("座位号") = drs(n)(tj) - (drs(n)("考场号") - 1)*40
if 考场号 = 考场号的最大值 and 座位号 <= 5 True
drs(n)("考场号") = drs(n)("考场号") + 1
drs(n)("座位号") = 40 + drs(n)(tj) - (drs(n)("考场号") - 1)*40
end if
Next
Dim tj1 As String = xuanke & "排序"
Dim tj2 As String = xuanke & "考场号"
Dim tj3 As String = xuanke & "座位号"
Dim tj4 As String = xuanke & "序号"
Dim dr As DataRow = DataTables("成绩库").AddNew
Dim dr1 As List(Of DataRow) = DataTables("成绩库").Select("[年级] = \'" & nianji & "\'And [单位] = \'" & danwei & "\'And [组合] Like \'%" & xuanke & "%\'","" & value & "")
For n As Integer = 0 To dr1.Count - 1 \'遍历所有行
dr1(n)(tj1) = n + 1 \'设置排序
dr1(n)(tj2) = Math.Ceiling(dr1(n)(tj1)/40)
dr1(n)(tj3) = dr1(n)(tj1) - (dr1(n)(tj2) - 1)*40
Next
Tables("成绩库").Sort = "单位代码,年级代码,组合代码,考号排序"
\'Dim dr2 As List(Of DataRow) = DataTables("成绩库").Select("[年级] = \'" & nianji & "\'And [组合] Like \'%" & xuanke & "%\'","" & value & "")
\'For n As Integer = 0 To dr2.Count - 1 \'遍历所有行
\'dr2(n)(tj4) = n + 1 \'设置排序
\'Next
\'Dim dr1s As List(Of DataRow) = DataTables("成绩库").Select("[年级] = \'" & nianji & "\'")
\'For n As Integer = 0 To dr1s.Count - 1 \'遍历所有行
\'dr1s(n)(tj5) = n + 1 \'设置排序
\'Next
Next
Next
Next
Next
Next
DataTables("成绩库").ResumeRedraw
e.Form.Controls("Label1").text ="考号核对结束,可以进行下一步操作!"
DataTables("成绩库").ResumeRedraw
红色字体代码如何修改？请指教。谢谢！
此主题相关图片如下：尾考室.png
-- 发布时间：2021/7/16 15:45:00
--
考场号的最大值可以在一开始就使用compute查出来
至于座位号 <= 5这个看不出来，请上传实例测试
-- 发布时间：2021/7/16 17:17:00
--
怎么执行代码时又增加了504行？其他代码也有点问题。
| 下载信息 [文件大小： 下载次数： ] | |
 点击浏览该文件:高中考试考号考室座位号编排测试 - 副本.rar |
[此贴子已经被作者于2021/7/16 17:17:56编辑过]
-- 发布时间：2021/7/16 17:21:00
--
使用文字说明一下排位规则
-- 发布时间：2021/7/16 17:35:00
--
新高考考场、考室安排：分年级、分学科、分学科，语文、数学、英语、物理/历史可以用同一考场考室，化学、生物、政治、历史都不是同一时间考，每考生只选2科。
要求：每考室40人，尾考室不超过45人。
-- 发布时间：2021/7/16 20:37:00
--
if 考场号 = 考场号的最大值 and 座位号 <= 5 True
drs(n)("考场号") = drs(n)("考场号") - 1
drs(n)("座位号") = 40 + drs(n)(tj) - (drs(n)("考场号") - 1)*40
end if
-- 发布时间：2021/7/17 11:32:00
--
试试
……
Tables("成绩库").Sort = "姓名"
For Each Value As String In Values
For Each xuanke As String In xuankes
For Each danwei As String In DataTables("成绩库").GetValues("单位", " ")
For Each nianji As String In DataTables("成绩库").GetValues("年级","单位 = \'" & danwei & "\'" )
For Each zuhe As String In DataTables("成绩库").GetValues("组合","年级 = \'" & nianji & "\'" )
Dim tj As String = value & "排序"
\'Dim tj5 As String = "序号"
Dim drs As List(Of DataRow) = DataTables("成绩库").Select("[年级] = \'" & nianji & "\'And [单位] = \'" & danwei & "\'", "" & value & "")
Dim idx As Integer = 1
For n As Integer = 0 To drs.Count - 1 Step 40 \'遍历所有行
Dim idx2 As Integer = 1
For k As Integer = n To math.min(n+39,drs.Count - 1)
drs(k)(tj) = k + 1 \'设置排序
drs(k)("考场号") = idx
drs(k)("座位号") = idx2
idx2 += 1
Next
If n+44 >= drs.Count - 1 Then
For k As Integer = n+40 To drs.Count - 1
drs(k)(tj) = k + 1 \'设置排序
drs(k)("考场号") = idx
drs(k)("座位号") = idx2
idx2 += 1
Next
exit for
End If
idx + =1
Next
Dim tj1 As String = xuanke & "排序"
Dim tj2 As String = xuanke & "考场号"
Dim tj3 As String = xuanke & "座位号"
……
-- 发布时间：2021/7/17 22:21:00
--
谢谢！经测试，要求已经满足，但代码怎么执行时又增加了504行空白？不知代码哪里出了点问题？请指教。
DataTables("成绩库").StopRedraw
Dim xuankes() As String = {"化","生","政","地"}
Dim Values() As String = {"考号"}
For Each Value As String In Values
Tables("成绩库").Cols(Value & "排序").Visible = True
Next
Tables("成绩库").Sort = "姓名"
For Each Value As String In Values
For Each xuanke As String In xuankes
For Each danwei As String In DataTables("成绩库").GetValues("单位", " ")
For Each nianji As String In DataTables("成绩库").GetValues("年级","单位 = \'" & danwei & "\'" )
For Each zuhe As String In DataTables("成绩库").GetValues("组合","年级 = \'" & nianji & "\'" )
Dim tj As String = value & "排序"
\'Dim tj5 As String = "序号"
Dim drs As List(Of DataRow) = DataTables("成绩库").Select("[年级] = \'" & nianji & "\'And [单位] = \'" & danwei & "\'", "" & value & "")
Dim idx As Integer = 1
For n As Integer = 0 To drs.Count - 1 Step 40 \'遍历所有行
Dim idx2 As Integer = 1
For k As Integer = n To math.min(n+39,drs.Count - 1)
drs(k)(tj) = k + 1 \'设置排序
drs(k)("考场号") = idx
drs(k)("座位号") = idx2
idx2 += 1
Next
If n+44 >= drs.Count - 1 Then
For k As Integer = n+40 To drs.Count - 1
drs(k)(tj) = k + 1 \'设置排序
drs(k)("考场号") = idx
drs(k)("座位号") = idx2
idx2 += 1
Next
Exit For
End If
idx + =1
Next
Dim tj1 As String = xuanke & "排序"
Dim tj2 As String = xuanke & "考场号"
Dim tj3 As String = xuanke & "座位号"
Dim tj4 As String = xuanke & "序号"
Dim dr As DataRow = DataTables("成绩库").AddNew
Dim dr1 As List(Of DataRow) = DataTables("成绩库").Select("[年级] = \'" & nianji & "\'And [单位] = \'" & danwei & "\'And [组合] Like \'%" & xuanke & "%\'","" & value & "")
Dim idx1 As Integer = 1
For n As Integer = 0 To dr1.Count - 1 Step 40 \'遍历所有行
Dim idx3 As Integer = 1
For k As Integer = n To math.min(n+39,dr1.Count - 1)
dr1(k)(tj1) = k + 1 \'设置排序
dr1(k)(tj2) = idx1
dr1(k)(tj3) = idx3
idx3 += 1
Next
If n+44 >= dr1.Count - 1 Then
For k As Integer = n+40 To dr1.Count - 1
dr1(k)(tj1) = k + 1 \'设置排序
dr1(k)(tj2) = idx1
dr1(k)(tj3) = idx3
idx3 += 1
Next
Exit For
End If
idx1 + =1
Next
Tables("成绩库").Sort = "单位代码,年级代码,组合代码,考号排序"
Next
Next
Next
Next
Next
DataTables("成绩库").ResumeRedraw
e.Form.Controls("Label1").text ="考号核对结束,可以进行下一步操作!"
-- 发布时间：2021/7/18 20:28:00
--
组合这个列是干嘛用的
-- 发布时间：2021/7/19 10:47:00
--
组合列是考生选科列，物理、历史是必选一科，化学、生物、政治、地理任选两科。所以就存在物生政、史化政...等12个组合。