主题：超过10组的分组分道问题

y2287958老师设计的分组分道效果非常好，但是超过10组就只能分组而不能分道了，如果超过10组也可以继续分道，代码应该如何修改？

 

下载信息  [文件大小：   下载次数： ]

点击浏览该文件:分组分道（超过10组）.rar

y2287958老师请改一改代码，谢谢了！

 呃，表A在哪里？附上数据源

代码中“8”改成“10”基本解决问题

代码中“8”改成“10”后就变成每组10 道了，运动场的跑道最多只有8道。还有一个很重要的问题需要解决，因为在“项目”列中有很多运动项目，如1500米、3000米、跳高、跳远、铅球等都不需要分道。所以我希望只对筛选出来的项目如100M进行分组分道，没有筛选出来的项目就不进行分组分道。也就是目前要解决二个问题。1、超过10组的分组分道(最多只能8道)；2、只对筛选出来的项目进行分组分道。第二个问题很重要。

见带数据库附件：

下载信息  [文件大小：   下载次数： ]

点击浏览该文件:分组分道（超过10组带数据库）.rar

 代码改成这样

测试成功，谢谢甜老师！

6楼的代码，在Table("表A").Filter = ""  的时候，会报错。

稍改一下：

Dim ss As List(of String) = DataTables("表A").GetValues("项目", Tables("表A").Filter)
Dim flt As String
If Tables("表A").Filter > "" Then
    flt = " And " & Tables("表A").Filter
Else
    flt = ""
End If
For Each s As String In ss
    Dim drs As List(Of DataRow) = DataTables("表A").Select("项目 = '" & s & "'" & flt,"单位")
    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 & "'" & flt)
                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 & "'" & flt)
    For Each s1 As Integer In ss1
        Dim drs As List(of DataRow) = DataTables("表A").Select("项目 = '" & s & "'and 预赛组别='" & s1 & "'" & flt,"单位")
        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 = "项目,预赛组别,预赛道次"

谢谢lsy老师！

lsy老师的代码也需要修改。6楼的代码在运行时，如果没有筛选就按“分组分道”按键，会跳出一个出错窗口，现在只需要把窗口中的内容修改为：“请选择比赛项目再分组分道”的提示，就非常完美了，用户根据提示再重新操作。