Foxtable(狐表) → 用户栏目 → 专家坐堂 → [求助]点上面的国开教室安排老是计算要很长时间，而且死机，哪位高手有设有更好的计算方法？求助


  共有2494人关注过本帖树形打印复制链接

主题：[求助]点上面的国开教室安排老是计算要很长时间，而且死机，哪位高手有设有更好的计算方法？求助
帅哥哟，离线，有人找我吗？
zgjmost
 小大  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：一尾狐 帖子：498 积分：4611 威望：0 精华：0 注册：2013/4/25 8:02:00 		[求助]点上面的国开教室安排老是计算要很长时间，而且死机，哪位高手有设有更好的计算方法？求助  发帖心情 Post By：2016/12/6 20:47:00 [只看该作者]

[求助]点上面的国开教室安排老是计算要很长时间，而且死机，哪位高手有设有更好的计算方法？求助

http://url.cn/42DL4nG

程序在上面的连接中！

谢谢
 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：110597 积分：562881 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2016/12/6 21:52:00 [只看该作者]

Dim bb As New SQLGroupTableBuilder("国考秩序册","国开课程表")
bb.Groups.AddDef("考试地址")
bb.Groups.AddDef("日期")
bb.Groups.AddDef("时间")
bb.Groups.AddDef("试卷号")
bb.Groups.AddDef("保密号")
bb.Totals.AddExp("人数","1")
bb.Build
MainTable = Tables("国考秩序册")
Output.Show(Date.Now)
For Each arrr As DataRow In DataTables("国考秩序册").Select("试卷号 is not null")
    
    Dim ar3 As DataRow
    ar3 = DataTables("国开秩序安排").AddNew()
    ar3("考试地址") = arrr("考试地址")
    ar3("日期") = arrr("日期")
    ar3("时间") = arrr("时间")
    ar3("试卷号") = arrr("试卷号")
    ar3("保密号") = arrr("保密号")
    ar3("人数") = arrr("人数")

        Dim dr11 As DataRow
    If ar3.IsNull("保密号") = False Then
        dr11 = DataTables("国开课程表").find("保密号 = '" & ar3("保密号") & "'")
    Else
        dr11 = DataTables("国开课程表").find("试卷号 = '" & ar3("试卷号") & "'")
    End If
    If dr11 IsNot Nothing Then
        ar3("考试地址") = dr11("考试地址")
        ar3("试卷名称") = dr11("试卷名称")
        ar3("考试类型") = dr11("考试类型")
        ar3("短日期") = dr11("短日期")
        ar3("考场号") = dr11("考场号")
        ar3("是否留考") = dr11("是否留考")
        ar3("考场号") = dr11("考场号")
        ar3("起始时间") = dr11("起始时间")
        ar3("结束时间") = dr11("结束时间")
        ar3("时长") = dr11("时长")
    End If
Next

Output.Show(Date.Now)
Tables("国开秩序安排").Sort = "短日期,起始时间,人数"

Dim Book2 As New XLS.Book(ProjectPath & "Attachments\国考秩序安排教室.xls ")
Dim fl1 As String = ProjectPath & "Reports\国考秩序供安排之用教室.xls"
Book2.Build() '生成细节区
Book2.Save(fl1) '保存工作簿
Output.Show(Date.Now)
Forms("国考考场编排建议").OPEN
 回到顶部
帅哥哟，离线，有人找我吗？
zgjmost
 小大  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：一尾狐 帖子：498 积分：4611 威望：0 精华：0 注册：2013/4/25 8:02:00 		  发帖心情 Post By：2016/12/7 6:44:00 [只看该作者]

你这个代码没改变
你试过吗？
 回到顶部
帅哥哟，离线，有人找我吗？
zgjmost
 小大  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：一尾狐 帖子：498 积分：4611 威望：0 精华：0 注册：2013/4/25 8:02:00 		  发帖心情 Post By：2016/12/7 7:36:00 [只看该作者]

Dim cls As List(Of DataRow) = DataTables("可供安排的教室").Select("", "优先使用顺序")

Dim dt As DataTable = DataTables("国开秩序安排")
dt.ResumeRedraw
dt.StopRedraw

'尽量不要一次性计算全部,因为运算是很慢的
Dim rqsjs As List(Of String()) = dt.GetValues("考试地址|日期|时间")
For Each rqsj() As String In rqsjs
    vars("cidx") = 0
    Dim filter As String = "考试地址 = '" & rqsj(0) & "' and 日期 = '" & rqsj(1) & "' and 时间 = '" & rqsj(2) & "'"
    Dim drs As List(Of DataRow) = dt.Select(filter, "人数 desc")
    Dim Ispick As new List(of Integer)
    Dim b(drs.Count-1) As Integer
    For i As Integer = 1 To drs.Count
        If i <= drs.Count - IsPick.Count Then
            e.Form.Controls("显示").Text = rqsj(0) & " " & rqsj(1) & " " & rqsj(2) & "(" & i & " " & drs.Count & " " & IsPick.count & ")"
            application.DoEvents
            Functions.Execute("组合排列", drs, b.length, i, b, i, cls, IsPick)
        End If
    Next
    Dim left As Integer = cls(vars("cidx"))("最大安排人数")
    For i As Integer = drs.count - 1 To 0 Step -1
        If Ispick.Contains(i) = False Then
            If left >= drs(i)("人数") Then
                drs(i)("教室") = cls(vars("cidx"))("教室名称")
                left -= drs(i)("人数")
            Else
                vars("cidx") += 1
                If cls.Count > vars("cidx") Then
                    left = cls(vars("cidx"))("最大安排人数")
                    drs(i)("教室") = cls(vars("cidx"))("教室名称")
                    left -= drs(i)("人数")
                Else
                    drs(i)("教室") = "教室不够"
                End If
            End If
        End If
    Next
Next
dt.ResumeRedraw

Tables("国开秩序安排").Sort = "考试地址,短日期,起始时间,人数"
   
    Dim Book2 As New XLS.Book(ProjectPath & "Attachments\国考秩序安排教室.xls ")
    Dim fl1 As String = ProjectPath & "Reports\国考秩序安排供安排之用(有建议教室安排).xls"
    Book2.Build() '生成细节区
    Book2.Save(fl1) '保存工作簿

msgbox("祝贺您!国考教室安排建议计算完毕,实际安排以您的最终安排为准!")
 回到顶部
帅哥哟，离线，有人找我吗？
zgjmost
 小大  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：一尾狐 帖子：498 积分：4611 威望：0 精华：0 注册：2013/4/25 8:02:00 		  发帖心情 Post By：2016/12/7 7:43:00 [只看该作者]

对程序又进行了优化，但还是计算中断

http://url.cn/42E5X8N

Dim cls As List(Of DataRow) = DataTables("可供安排的教室").Select("", "优先使用顺序")

Dim dt As DataTable = DataTables("国开秩序安排")
dt.ResumeRedraw
dt.StopRedraw

'尽量不要一次性计算全部,因为运算是很慢的
Dim rqsjs As List(Of String()) = dt.GetValues("考试地址|日期|时间")
For Each rqsj() As String In rqsjs
    vars("cidx") = 0
    Dim filter As String = "考试地址 = '" & rqsj(0) & "' and 日期 = '" & rqsj(1) & "' and 时间 = '" & rqsj(2) & "'"
    Dim drs As List(Of DataRow) = dt.Select(filter, "人数 desc")
    Dim Ispick As new List(of Integer)
    Dim b(drs.Count-1) As Integer
    For i As Integer = 1 To drs.Count
        If i <= drs.Count - IsPick.Count Then
            e.Form.Controls("显示").Text = rqsj(0) & " " & rqsj(1) & " " & rqsj(2) & "(" & i & " " & drs.Count & " " & IsPick.count & ")"
            application.DoEvents
            Functions.Execute("组合排列", drs, b.length, i, b, i, cls, IsPick)
        End If
    Next
    Dim left As Integer = cls(vars("cidx"))("最大安排人数")
    For i As Integer = drs.count - 1 To 0 Step -1
        If Ispick.Contains(i) = False Then
            If left >= drs(i)("人数") Then
                drs(i)("教室") = cls(vars("cidx"))("教室名称")
                left -= drs(i)("人数")
            Else
                vars("cidx") += 1
                If cls.Count > vars("cidx") Then
                    left = cls(vars("cidx"))("最大安排人数")
                    drs(i)("教室") = cls(vars("cidx"))("教室名称")
                    left -= drs(i)("人数")
                Else
                    drs(i)("教室") = "教室不够"
                End If
            End If
        End If
    Next
Next
dt.ResumeRedraw

Tables("国开秩序安排").Sort = "考试地址,短日期,起始时间,人数"
   
    Dim Book2 As New XLS.Book(ProjectPath & "Attachments\国考秩序安排教室.xls ")
    Dim fl1 As String = ProjectPath & "Reports\国考秩序安排供安排之用(有建议教室安排).xls"
    Book2.Build() '生成细节区
    Book2.Save(fl1) '保存工作簿

msgbox("祝贺您!国考教室安排建议计算完毕,实际安排以您的最终安排为准!")

主要是上面这段代码能不能优化？
 回到顶部
帅哥哟，离线，有人找我吗？
zgjmost
 小大  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：一尾狐 帖子：498 积分：4611 威望：0 精华：0 注册：2013/4/25 8:02:00 		  发帖心情 Post By：2016/12/7 7:43:00 [只看该作者]

自定义函数

 

组合排列

 

Dim a As object = args(0)

Dim n As Integer = args(1)

Dim m As Integer = args(2)

Dim b() As Integer = args(3)

Dim Mm As Integer = args(4)

Dim cls As object = args(5)

Dim IsPick As Object = args(6)

 

For i As Integer = n To m Step -1

    If IsPick.Contains(i-1) = False Then

        b(m-1) = i-1

        If m > 1 Then

            Functions.Execute("组合排列", a, i-1, m-1, b, Mm, cls, IsPick)

        Else

            Dim sum As Double = 0

            For j As Integer = 0 To Mm - 1

                If IsPick.Contains(b(j)) Then Return Nothing

                sum += a(b(j))("人数")

            Next

            If sum = cls(vars("cidx"))("最大安排人数") Then

                For j As Integer = Mm - 1 To 0 Step -1

                    a(b(j))("教室") = cls(vars("cidx"))("教室名称")

                    IsPick.add(b(j))

                Next

                vars("cidx") += 1

            End If

        End If

    End If

Next

 

全局代码

 

Default

 

Public delimg As Image = GetImage("del.png")

 还有上面这个能不能优化下！
 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：110597 积分：562881 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2016/12/7 8:23:00 [只看该作者]

我以为你是说菜单按钮的计算慢，原来是窗口的计算按钮事件慢。

麻烦详细描述一下按钮的整个整个计算逻辑，或者说说按什么规则来安排教室
 回到顶部
帅哥哟，离线，有人找我吗？
zgjmost
 小大  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：一尾狐 帖子：498 积分：4611 威望：0 精华：0 注册：2013/4/25 8:02:00 		  发帖心情 Post By：2016/12/7 9:35:00 [只看该作者]

Dim cls As List(Of DataRow) = DataTables("可供安排的教室").Select("", "优先使用顺序")

Dim dt As DataTable = DataTables("国开秩序安排")
dt.ResumeRedraw
dt.StopRedraw

'尽量不要一次性计算全部,因为运算是很慢的
Dim rqsjs As List(Of String()) = dt.GetValues("考试地址|日期|时间")
For Each rqsj() As String In rqsjs
    vars("cidx") = 0
    Dim filter As String = "考试地址 = '" & rqsj(0) & "' and 日期 = '" & rqsj(1) & "' and 时间 = '" & rqsj(2) & "'"
    Dim drs As List(Of DataRow) = dt.Select(filter, "人数 desc")
    Dim Ispick As new List(of Integer)
    Dim b(drs.Count-1) As Integer
    For i As Integer = 1 To drs.Count
        If i <= drs.Count - IsPick.Count Then
            e.Form.Controls("显示").Text = rqsj(0) & " " & rqsj(1) & " " & rqsj(2) & "(" & i & " " & drs.Count & " " & IsPick.count & ")"
            application.DoEvents
            Functions.Execute("组合排列", drs, b.length, i, b, i, cls, IsPick)
        End If
    Next
    Dim left As Integer = cls(vars("cidx"))("最大安排人数")
    For i As Integer = drs.count - 1 To 0 Step -1
        If Ispick.Contains(i) = False Then
            If left >= drs(i)("人数") Then
                drs(i)("教室") = cls(vars("cidx"))("教室名称")
                left -= drs(i)("人数")
            Else
                vars("cidx") += 1
                If cls.Count > vars("cidx") Then
                    left = cls(vars("cidx"))("最大安排人数")
                    drs(i)("教室") = cls(vars("cidx"))("教室名称")
                    left -= drs(i)("人数")
                Else
                    drs(i)("教室") = "教室不够"
                End If
            End If
        End If
    Next
Next
dt.ResumeRedraw

Tables("国开秩序安排").Sort = "考试地址,短日期,起始时间,人数"
   
    Dim Book2 As New XLS.Book(ProjectPath & "Attachments\国考秩序安排教室.xls ")
    Dim fl1 As String = ProjectPath & "Reports\国考秩序安排供安排之用(有建议教室安排).xls"
    Book2.Build() '生成细节区
    Book2.Save(fl1) '保存工作簿

msgbox("祝贺您!国考教室安排建议计算完毕,实际安排以您的最终安排为准!")
 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  9楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：110597 积分：562881 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2016/12/7 9:51:00 [只看该作者]

正因为看不懂你的代码，也没有时间仔细跟踪分析你的逻辑，所以才让你说说按什么规则来安排教室。麻烦用文字表达一下

 回到顶部
帅哥哟，离线，有人找我吗？
有点色
 小大  10楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：13837 积分：69650 威望：0 精华：0 注册：2016/11/1 14:42:00 		  发帖心情 Post By：2016/12/7 10:23:00 [只看该作者]

 无法优化，组合排列本身就是慢的，数据量越大组合的情况越多就越慢。

 

 你排的时候，不要有太多的数据需要组合才行啊。
 回到顶部
总数 11 1 2 下一页
RSS2.0 | Xhtml无图版 | Xslt无图版 Copyright © 2000 - 2018 foxtable.com Tel: 4000-810-820 粤ICP备11091905号
   Powered By Dvbbs Version 8.3.0
页面执行时间 0.05469 秒, 4 次数据查询