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

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  排号  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=130983)

--  作者：刘林
--  发布时间：2019/2/13 16:31:00
--  排号

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

老师：新年好，请教一个排号问题：看了例子中的随机排号等还是不能完成，请老师帮忙下

目的：
所有记录分派到了几个kdxxdm（考点),每个考点按人数多少设30人一个考试室，在该考点的学生随机抽取分派至考试室，尾考试室不大于40个人，ksh原则：1802+（3位考试室序号)+(2位座位号）考试室序号要连续，即考点2的考试室号连在考点1的最大考试室走。

做了很多尝试做法还是做不好，请老师帮写个做法，谢谢!

--  作者：有点甜
--  发布时间：2019/2/13 17:18:00
--

Dim dt As DataTable = DataTables("zk")
dt.StopRedraw()

Dim kds = dt.GetValues("kdxxdm")
Dim js As Integer = 1
Dim zw As Integer = 0
For Each kd As String In kds
    Dim drs = dt.Select("kdxxdm = \'" & kd & "\'")
    Dim cnt As Integer = drs.count
    Dim ids(cnt - 1) As Integer
    For i As Integer = 0 To cnt -1
        ids(i) = i
    Next
    For i As Integer = 0 To cnt \'洗牌次数
        Dim id1 As Integer = rand.Next(0,cnt)
        Dim id2 As Integer = rand.Next(0,cnt)
        Dim vid As Integer = ids(id1)
        ids(id1) = ids(id2)
        ids(id2) = vid
    Next
    For i As Integer = 0 To cnt-1
        If zw > 29 Then
            js += 1
            zw = 1
        Else
            zw += 1
        End If
        drs(ids(i))("ksh") = "1802" & Format(js, "000") & Format(zw, "00")
    Next
Next

dt.ResumeRedraw()

--  作者：刘林
--  发布时间：2019/2/13 18:13:00
--

Dim cut As Integer = DataTables("zk").DataRows.Count
For Each dr As DataRow In DataTables("zk").DataRows
dr("ksh") = rand.Next(0,cut)
Next
Dim kds As List(Of String)= DataTables("zk").GetValues("kdxxdm")
Dim kch As Integer = 0
For Each kd As String In kds
Dim drs As List(Of DataRow)= DataTables("zk").Select("kdxxdm = \'" & kd & "\'","ksh")
Dim zwh As Integer = 1
Dim ws As Integer = drs.Count Mod 30
Dim kczs As Integer = iif(ws>10,Math.Floor(drs.count/30)+1,Math.Floor(drs.count/30))
kch=kch+1
Dim i As Integer=1
For Each dr As DataRow In drs
dr("ksh")= Format(kch,"000") & Format(zwh,"00")
zwh=zwh+1
If zwh>30 And i<=kczs-1
zwh=1
kch=kch+1
i=i+1
End If
Next
Tables("zk").sort="kdxxdm,ksh"
Next

老师，我出试着了做出的结果这样请老师看下有漏洞没有

--  作者：刘林
--  发布时间：2019/2/13 18:18:00
--
测试了上面代码当换一考点了，考试室没有变，坐位号也是顺到走的，因为换了考点了，考试室要进一，并且考试号也应坐位应从第01开始

--  作者：有点甜
--  发布时间：2019/2/13 22:54:00
--

Dim dt As DataTable = DataTables("zk")
dt.StopRedraw()

Dim kds = dt.GetValues("kdxxdm")
Dim js As Integer = 1
Dim zw As Integer = 0
For Each kd As String In kds
    js += 1
    zw = 0
    Dim drs = dt.Select("kdxxdm = \'" & kd & "\'")
    Dim cnt As Integer = drs.count
    Dim ids(cnt - 1) As Integer
    For i As Integer = 0 To cnt -1
        ids(i) = i
    Next
    For i As Integer = 0 To cnt \'洗牌次数
        Dim id1 As Integer = rand.Next(0,cnt)
        Dim id2 As Integer = rand.Next(0,cnt)
        Dim vid As Integer = ids(id1)
        ids(id1) = ids(id2)
        ids(id2) = vid
    Next
    For i As Integer = 0 To cnt-1
        If zw > 29 Then
            js += 1
            zw = 1
        Else
            zw += 1
        End If
        drs(ids(i))("ksh") = "1802" & Format(js, "000") & Format(zw, "00")
    Next
Next

dt.ResumeRedraw()

--  作者：刘林
--  发布时间：2019/2/13 23:05:00
--
谢谢，对了，我做的也可以，但比你这个就整复杂了，谢谢

但还有个问题就是当余数不足10个就在最后一个考试室一并安排这个没有处理到

[此贴子已经被作者于2019/2/13 23:07:11编辑过]

--  作者：有点甜
--  发布时间：2019/2/14 9:00:00
--

Dim dt As DataTable = DataTables("zk")
dt.StopRedraw()

Dim kds = dt.GetValues("kdxxdm")
Dim js As Integer = 1
Dim zw As Integer = 0
For Each kd As String In kds
    js += 1
    zw = 0
    Dim drs = dt.Select("kdxxdm = \'" & kd & "\'")
    Dim cnt As Integer = drs.count
    Dim ids(cnt - 1) As Integer
    For i As Integer = 0 To cnt -1
        ids(i) = i
    Next
    For i As Integer = 0 To cnt \'洗牌次数
        Dim id1 As Integer = rand.Next(0,cnt)
        Dim id2 As Integer = rand.Next(0,cnt)
        Dim vid As Integer = ids(id1)
        ids(id1) = ids(id2)
        ids(id2) = vid
    Next
    For i As Integer = 0 To cnt-1
        If zw > 29 Then
            If cnt-i+1 > 10 Then
                js += 1
                zw = 1
            Else
                zw += 1
            End If
        Else
            zw += 1
        End If
        drs(ids(i))("ksh") = "1802" & Format(js, "000") & Format(zw, "00")
    Next
Next

dt.ResumeRedraw()