以文本方式查看主题 - Foxtable(狐表) (http://foxtable.net/bbs/index.asp) -- 专家坐堂 (http://foxtable.net/bbs/list.asp?boardid=2) ---- 超过10组的分组分道问题 (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=46166) |
||||
-- 作者:aygp -- 发布时间:2014/2/18 11:20:00 -- 超过10组的分组分道问题 y2287958老师设计的分组分道效果非常好,但是超过10组就只能分组而不能分道了,如果超过10组也可以继续分道,代码应该如何修改?
|
||||
-- 作者:aygp -- 发布时间:2014/2/18 17:13:00 -- y2287958老师请改一改代码,谢谢了! |
||||
-- 作者:有点甜 -- 发布时间:2014/2/18 20:17:00 -- 呃,表A在哪里?附上数据源 |
||||
-- 作者:y2287958 -- 发布时间:2014/2/19 8:07:00 -- 代码中“8”改成“10”基本解决问题 类似问题,软件只能分类到一定程度,最后还是要人工再优化一下的。
|
||||
-- 作者:aygp -- 发布时间:2014/2/19 11:23:00 -- 代码中“8”改成“10”后就变成每组10 道了,运动场的跑道最多只有8道。还有一个很重要的问题需要解决,因为在“项目”列中有很多运动项目,如1500米、3000米、跳高、跳远、铅球等都不需要分道。所以我希望只对筛选出来的项目如100M进行分组分道,没有筛选出来的项目就不进行分组分道。也就是目前要解决二个问题。1、超过10组的分组分道(最多只能8道);2、只对筛选出来的项目进行分组分道。第二个问题很重要。 见带数据库附件:
|
||||
-- 作者:有点甜 -- 发布时间:2014/2/19 22:27:00 -- 代码改成这样 Dim ss As List(of String) = DataTables("表A").GetValues("项目", Tables("表A").Filter) For Each s As String In ss Dim drs As List(of DataRow) = DataTables("表A").Select("项目=\'" & s & "\' and " & Tables("表A").Filter, "单位") drs(0)("预赛组别") = 1 For i As Integer = 1 To drs.Count - 1 Dim i1 As Integer = drs(i-1)("预赛组别") If i1 >= Math.Ceiling(drs.Count/8) For i2 As Integer = 1 To 8 Dim i3 As Integer = DataTables("表A").Compute("Count(项目)","项目=\'" & s & "\' and 预赛组别=\'" & i2 & "\' and " & Tables("表A").Filter) If i3 < Math.Ceiling(drs.Count/8) drs(i)("预赛组别") = 1 Else drs(i)("预赛组别") = i3 End If Next Else drs(i)("预赛组别") = i1 + 1 End If Next Next For Each s As String In ss Dim ss1 As List(of String) = DataTables("表A").GetValues("预赛组别","项目=\'" & s & "\' and " & Tables("表A").Filter) For Each s1 As Integer In ss1 \' Dim drs As List(of DataRow) = DataTables("表A").Select("项目=\'" & s & "\'and 预赛组别=" & s1,"单位") Dim drs As List(of DataRow) = DataTables("表A").Select("项目=\'" & s & "\'and 预赛组别=\'" & s1 & "\' and " & Tables("表A").Filter,"单位") drs(0)("预赛道次") = 1 For i As Integer = 1 To drs.Count - 1 drs(i)("预赛道次") = drs(i-1)("预赛道次") + 1 Next For i As Integer = 1 To drs.Count - 1 If drs(i)("单位") = drs(i-1)("单位") If (i-4)>=0 drs(i)("预赛道次") = i-4+1 drs(i-4)("预赛道次") = i+1 ElseIf (i+4)<=drs.Count drs(i)("预赛道次") = i+4+1 drs(i+4)("预赛道次") = i+1 End If End If Next Next Next Tables("表A").Sort = "项目,预赛组别,预赛道次" 清除跑道的代码 DataTables("表A").ReplaceFor("预赛组别",Nothing,Tables("表A").Filter) DataTables("表A").ReplaceFor("预赛道次",Nothing,Tables("表A").Filter) |
||||
-- 作者:aygp -- 发布时间:2014/2/20 0:47:00 -- 测试成功,谢谢甜老师! |
||||
-- 作者:lsy -- 发布时间:2014/2/20 8:34:00 -- 6楼的代码,在Table("表A").Filter = "" 的时候,会报错。 稍改一下: Dim ss As List(of String) = DataTables("表A").GetValues("项目", Tables("表A").Filter) |
||||
-- 作者:aygp -- 发布时间:2014/2/20 11:38:00 -- 谢谢lsy老师! |
||||
-- 作者:aygp -- 发布时间:2014/2/20 12:19:00 -- lsy老师的代码也需要修改。6楼的代码在运行时,如果没有筛选就按“分组分道”按键,会跳出一个出错窗口,现在只需要把窗口中的内容修改为:“请选择比赛项目再分组分道”的提示,就非常完美了,用户根据提示再重新操作。 |