Foxtable(狐表) → 用户栏目 → 专家坐堂 → [求助]老师，这个随机筛选如果实现，帮忙写下代码


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

主题：[求助]老师，这个随机筛选如果实现，帮忙写下代码
帅哥哟，离线，有人找我吗？
hbfnmxb
 小大  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：二尾狐 帖子：559 积分：6330 威望：0 精华：0 注册：2008/9/7 20:15:00 		[求助]老师，这个随机筛选如果实现，帮忙写下代码  发帖心情 Post By：2024/9/5 20:53:00 [显示全部帖子]

无法插入图片？图片如何插入？

这个代码如下：但不能实现我想要的，老师帮忙写下代码：
有一个FS控件、有一个CFS控件、有一个WFS控件、还有一个BDF控件，筛选的分数区间是：第一个区间，小于FS+CFS，大于FS，第二个分数区间 ，小于FS，大于FS-WFS，第三个分数区间是，小于FS-WFS，大于FS-BDF。这三个分数区间分别设定具体个数，第一个分数区间设定的个数是：CSL控件中的个数，第二个分数区间是：WSL控件中的个数，第三个分数区间是BSL控件中的个数，这段代码如何来写，老师帮忙写一下，非常感谢！

e.Form.Controls("Label6").Text = "正在进行专业筛选,请稍后..."
Application.DoEvents()
Dim timestart, timeend As Date
timestart = Date.now

Dim drs As List(Of DataRow)
drs = DataTables("基础数据").Select("[确定导入] = True")
For Each dr As DataRow In drs
    dr("确定导入") = False
Next

Dim Filter As String
If e.Form.Controls("选择历史").Checked = True Then
    If Filter > "" Then
        Filter = Filter & " And "
    End If
    Filter = Filter & "首选科目 = '历史'"
End If
If e.Form.Controls("选择物理").Checked = True Then
    If Filter > "" Then
        Filter = Filter & " And "
    End If
    Filter = Filter & "首选科目 = '物理'"
End If

Dim s As String = e.Form.Controls("CheckedComboBox1").Text
 '考生选科数组
's=s.replace("物理","").replace("历史","").replace(",,",",").trim(",")  '只剩下再选科目
'Output.Show(s)
Dim Xks() As String '考生选科集合
Xks = s.split(",")
Dim Jhxks As List(Of String) '招生计划中的选科
Jhxks = DataTables("基础数据").GetValues("次选科目")
Dim Xkmys As New List(Of String) '与我的选科匹配的选科集合
Xkmys.Add("不限")
Xkmys.Add(Xks(0) & "和" & Xks(1))
Xkmys.Add(Xks(1) & "和" & Xks(0))
''单科加"或"
For Index As Integer = 0 To Xks.Length - 1 '提示错误的位置在这里!
    For Each Product As String In Jhxks
        If (Product.contains(Xks(Index) & "或") Or Product.contains("或" & Xks(Index)) Or Product = Xks(Index)) And Xkmys.Contains(Product) = False Then
            'filter=filter & "'" & Product & "'"
            'Jhxks.Remove(Product)
            Xkmys.Add(Product)
        End If
    Next
Next
'加组合,手动填加,
'开始生成筛选条件
Dim tj As String
For Each filter2 As String In Xkmys
    tj = tj & "'" & filter2 & "',"
Next
tj = "[次选科目] In (" & tj.trim(",") & ")"
Tables("基础数据").Filter = tj
output.Show(tj)

If e.Form.Controls("FS+CGF").text > "" Then
    If Filter > "" Then
        Filter = Filter & " And "
    End If
    Filter = Filter & "预估分 <= " & e.Form.Controls("FS+CGF").text
End If

If e.Form.Controls("FS").text > "" Then
    If Filter > "" Then
        Filter = Filter & " And "
    End If
    Filter = Filter & "预估分 >= " & e.Form.Controls("FS").text
End If


If e.Form.Controls("FS").text > "" Then
    If Filter > "" Then
        Filter = Filter & " And "
    End If
    Filter = Filter & "预估分 <= " & e.Form.Controls("FS").text
End If

If e.Form.Controls("FS-WFS").text > "" Then
    If Filter > "" Then
        Filter = Filter & " And "
    End If
    Filter = Filter & "预估分 >= " & e.Form.Controls("FS-WFS").text
End If


If e.Form.Controls("FS-WFS").text > "" Then
    If Filter > "" Then
        Filter = Filter & " And "
    End If
    Filter = Filter & "预估分 <= " & e.Form.Controls("FS-WFS").text
End If

If e.Form.Controls("FS-BDF").text > "" Then
    If Filter > "" Then
        Filter = Filter & " And "
    End If
    Filter = Filter & "预估分 >= " & e.Form.Controls("FS-BDF").text
End If

If Filter > "" Then
If tj > "" Then 
Filter = Filter & " and " & tj
End If
    Tables("基础数据").Filter = Filter
End If

Tables("基础数据").Sort = "预估分 DESC" '按"低分等效"列降序排列

e.Form.Controls("Label6").Text = "专业筛选完毕!."
timeend = Date.now
e.Form.Controls("Label6").text = "耗时" & (timeend - timestart).TotalSeconds & "秒"
Messagebox.show("按专业【预估分】分,筛选出符合条件的行,共" & (Tables("基础数据").rows.count) & "行", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
MainTable = Tables("基础数据")


[此贴子已经被作者于2024/9/5 21:04:19编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
hbfnmxb
 小大  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：二尾狐 帖子：559 积分：6330 威望：0 精华：0 注册：2008/9/7 20:15:00 		  发帖心情 Post By：2024/9/6 18:16:00 [显示全部帖子]

附件大，压缩分开了。删除了历史数据，测试的时候，只能用物理数据了。谢谢老师

[此贴子已经被作者于2024/9/8 23:22:07编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
hbfnmxb
 小大  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：二尾狐 帖子：559 积分：6330 威望：0 精华：0 注册：2008/9/7 20:15:00 		  发帖心情 Post By：2024/9/8 15:49:00 [显示全部帖子]

老师，帮忙看一下！这个代码如何写
 回到顶部
帅哥哟，离线，有人找我吗？
hbfnmxb
 小大  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：二尾狐 帖子：559 积分：6330 威望：0 精华：0 注册：2008/9/7 20:15:00 		  发帖心情 Post By：2024/9/8 19:37:00 [显示全部帖子]


图片点击可在新窗口打开查看此主题相关图片如下：001.png
图片点击可在新窗口打开查看
图片点击可在新窗口打开查看此主题相关图片如下：002.png
图片点击可在新窗口打开查看

1首选科目，选择历史或物理，考生选科选择至少选择两个学科
2.随机筛选出96个，这96条，包含冲、稳、保，其中前36个为冲[CSL]控件中的个数，稳为40个从第37个开始，到76个也就是插件[WSL]中的个数，保为20条，从第77开始到96，也就是控件[BSL]中的个数。
3.分数区间：冲的最高分是“考生分数+冲的分数，也就是[FS+CGF]两个控件之和，冲的最低分是考生分数，即[FS]控件；稳的分数区间，稳的最高分就是考生分数，即[FS]，稳的最低分为[FS-WFS]控件之差；保的分数区间：保的最高分为[FS-WFS]之差，保的最低分为，考生分数减去保的分数，也就是[FS-BDF]的控件之差；
4筛选的表是：基础数据表，筛选的列是：预估分
5举例：如考生的分数是560分，要在基础数据表随机筛选出：
条件A：预估分<560+10、预估分>=560，36条（这是冲的）
条件B：预估分<560、预估分>=560-20，40条（这是稳的）
条件C：预估分<560-20、预估分>=560-30，20条（这是保的）
这三个条件加到一起正好是96条
 回到顶部
帅哥哟，离线，有人找我吗？
hbfnmxb
 小大  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：二尾狐 帖子：559 积分：6330 威望：0 精华：0 注册：2008/9/7 20:15:00 		  发帖心情 Post By：2024/9/9 10:32:00 [显示全部帖子]

也就是说，冲筛选一次、稳筛选一次、保筛选一次，然后三次的筛选结果加到一起？是这意思吧
 回到顶部
帅哥哟，离线，有人找我吗？
hbfnmxb
 小大  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：二尾狐 帖子：559 积分：6330 威望：0 精华：0 注册：2008/9/7 20:15:00 		  发帖心情 Post By：2024/9/10 7:41:00 [显示全部帖子]

基础数据表中有一列是逻辑列“确定导入”。如何把筛选数改成控件？[CSL]?
 回到顶部
帅哥哟，离线，有人找我吗？
hbfnmxb
 小大  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：二尾狐 帖子：559 积分：6330 威望：0 精华：0 注册：2008/9/7 20:15:00 		  发帖心情 Post By：2024/9/10 8:07:00 [显示全部帖子]

e.Form.Controls("Label6").Text = "正在进行专业筛选,请稍后..."
Application.DoEvents()
Dim timestart, timeend As Date
timestart = Date.now

Dim Filter As String
If e.Form.Controls("选择历史").Checked = True Then
    If Filter > "" Then
        Filter = Filter & " And "
    End If
    Filter = Filter & "首选科目 = '历史'"
End If
If e.Form.Controls("选择物理").Checked = True Then
    If Filter > "" Then
        Filter = Filter & " And "
    End If
    Filter = Filter & "首选科目 = '物理'"
End If

Dim s As String = e.Form.Controls("CheckedComboBox1").Text
Dim Xks() As String '考生选科集合
Xks = s.split(",")
Dim Jhxks As List(Of String) '招生计划中的选科
Jhxks = DataTables("基础数据").GetValues("次选科目")
Dim Xkmys As New List(Of String) '与我的选科匹配的选科集合
Xkmys.Add("不限")
Xkmys.Add(Xks(0) & "和" & Xks(1))
Xkmys.Add(Xks(1) & "和" & Xks(0))
''单科加"或"
For Index As Integer = 0 To Xks.Length - 1 '提示错误的位置在这里!
    For Each Product As String In Jhxks
        If (Product.contains(Xks(Index) & "或") Or Product.contains("或" & Xks(Index)) Or Product = Xks(Index)) And Xkmys.Contains(Product) = False Then
            'filter=filter & "'" & Product & "'"
            'Jhxks.Remove(Product)
            Xkmys.Add(Product)
        End If
    Next
Next
'加组合,手动填加,
'开始生成筛选条件
Dim tj As String
For Each filter2 As String In Xkmys
    tj = tj & "'" & filter2 & "',"
Next
tj = "[次选科目] In (" & tj.trim(",") & ")"
Tables("基础数据").Filter = tj



Dim cnt As Integer = DataTables("基础数据").DataRows.Count
Dim nds As Integer = e.Form.Controls("CSL").text '要抽取的记录数
Tables("基础数据").StopRedraw()
DataTables("基础数据").ReplaceFor("确定导入", False)
Do
    Dim idx As Integer = rand.Next(0, cnt)
    Dim dr As DataRow = DataTables("基础数据").DataRows(idx)
    If dr("确定导入") = False Then
        dr("确定导入") = True
        nds = nds - 1
    End If
Loop While nds > 0
Tables("基础数据").Filter = "[确定导入] = True"
Tables("基础数据").ResumeRedraw()


If Filter > "" Then
If tj > "" Then 
    Filter = Filter & " and " & tj
End If
Tables("基础数据").Filter = Filter
End If


Tables("基础数据").Sort = "预估分 DESC" '按"低分等效"列降序排列

e.Form.Controls("Label6").Text = "专业筛选完毕!."
timeend = Date.now
e.Form.Controls("Label6").text = "耗时" & (timeend - timestart).TotalSeconds & "秒"
Messagebox.show("按专业【预估分】分,筛选出符合条件的行,共" & (Tables("基础数据").rows.count) & "行", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
MainTable = Tables("基础数据")


这两段代码加到一起，筛选的不是36条了，是部的选科数据了，老师看一下，哪里的问题
 回到顶部
帅哥哟，离线，有人找我吗？
hbfnmxb
 小大  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：二尾狐 帖子：559 积分：6330 威望：0 精华：0 注册：2008/9/7 20:15:00 		  发帖心情 Post By：2024/9/10 11:06:00 [显示全部帖子]

老师，再看看下面这段代码，理论上应该筛选出96个，但是我加上分数区间的条件后，有的时候是36个，有的时候是67个，总之就是出不来96个，老师再给看看哪里的问题，谢谢老师

e.Form.Controls("Label6").Text = "正在进行专业筛选,请稍后..."
Application.DoEvents()
Dim timestart, timeend As Date
timestart = Date.now



Dim Filter As String
If e.Form.Controls("选择历史").Checked = True Then
    If Filter > "" Then
        Filter = Filter & " And "
    End If
    Filter = Filter & "首选科目 = '历史'"
End If
If e.Form.Controls("选择物理").Checked = True Then
    If Filter > "" Then
        Filter = Filter & " And "
    End If
    Filter = Filter & "首选科目 = '物理'"
End If

Dim s As String = e.Form.Controls("CheckedComboBox1").Text
Dim Xks() As String '考生选科集合
Xks = s.split(",")
Dim Jhxks As List(Of String) '招生计划中的选科
Jhxks = DataTables("基础数据").GetValues("次选科目")
Dim Xkmys As New List(Of String) '与我的选科匹配的选科集合
Xkmys.Add("不限")
Xkmys.Add(Xks(0) & "和" & Xks(1))
Xkmys.Add(Xks(1) & "和" & Xks(0))
''单科加"或"
For Index As Integer = 0 To Xks.Length - 1 '提示错误的位置在这里!
    For Each Product As String In Jhxks
        If (Product.contains(Xks(Index) & "或") Or Product.contains("或" & Xks(Index)) Or Product = Xks(Index)) And Xkmys.Contains(Product) = False Then
            'filter=filter & "'" & Product & "'"
            'Jhxks.Remove(Product)
            Xkmys.Add(Product)
        End If
    Next
Next
'加组合,手动填加,
'开始生成筛选条件
Dim tj As String
For Each filter2 As String In Xkmys
    tj = tj & "'" & filter2 & "',"
Next
tj = "[次选科目] In (" & tj.trim(",") & ")"
DataTables("基础数据").ReplaceFor("确定导入", False)

'添加分数区间条件
If Filter > "" Then
Filter = Filter & " and 确定导入=false"
End If
If tj > "" Then 
    Filter = Filter & " and " & tj
End If

If e.Form.Controls("CGF").text > "" Then
    If Filter > "" Then
        Filter = Filter & " And "
    End If
    Filter = Filter & "预估分 <= " & e.Form.Controls("CGF").text
End If

If e.Form.Controls("FS").text > "" Then
    If Filter > "" Then
        Filter = Filter & " And "
    End If
    Filter = Filter & "预估分 > " & e.Form.Controls("FS").text
End If

Tables("基础数据").Filter = Filter
Dim cnt As Integer = Tables("基础数据").Rows.Count
Dim nds As Integer = e.Form.Controls("CSL").text '要抽取的记录数
Tables("基础数据").StopRedraw()
Do
    Dim idx As Integer = rand.Next(0, cnt)
    Dim dr As Row = Tables("基础数据").Rows(idx)
        dr("确定导入") = True
        nds = nds - 1
Loop While nds > 0
Tables("基础数据").Filter = "[确定导入] = True"
Tables("基础数据").ResumeRedraw()

If e.Form.Controls("FS").text > "" Then
    If Filter > "" Then
        Filter = Filter & " And "
    End If
    Filter = Filter & "预估分 <= " & e.Form.Controls("FS").text
End If

If e.Form.Controls("WFS").text > "" Then
    If Filter > "" Then
        Filter = Filter & " And "
    End If
    Filter = Filter & "预估分 > " & e.Form.Controls("WFS").text
End If
Tables("基础数据").Filter = Filter
Dim wnt As Integer = Tables("基础数据").Rows.Count
Dim wds As Integer = e.Form.Controls("WSL").text '要抽取的记录数
Tables("基础数据").StopRedraw()
Do
    Dim idx As Integer = rand.Next(0, wnt)
    Dim dr As Row = Tables("基础数据").Rows(idx)
        dr("确定导入") = True
        wds = wds - 1
Loop While wds > 0
Tables("基础数据").Filter = "[确定导入] = True"
Tables("基础数据").ResumeRedraw()


If e.Form.Controls("WFS").text > "" Then
    If Filter > "" Then
        Filter = Filter & " And "
    End If
    Filter = Filter & "预估分 <= " & e.Form.Controls("WFS").text
End If

If e.Form.Controls("BDF").text > "" Then
    If Filter > "" Then
        Filter = Filter & " And "
    End If
    Filter = Filter & "预估分 >= " & e.Form.Controls("BDF").text
End If
Tables("基础数据").Filter = Filter
Dim bnt As Integer = Tables("基础数据").Rows.Count
Dim bds As Integer = e.Form.Controls("BSL").text '要抽取的记录数
Tables("基础数据").StopRedraw()
Do
    Dim idx As Integer = rand.Next(0, bnt)
    Dim dr As Row = Tables("基础数据").Rows(idx)
        dr("确定导入") = True
        bds = bds - 1
Loop While bds > 0
Tables("基础数据").Filter = "[确定导入] = True"
Tables("基础数据").ResumeRedraw()


Tables("基础数据").Sort = "预估分 DESC" '按"低分等效"列降序排列
e.Form.Controls("Label6").Text = "专业筛选完毕!."
timeend = Date.now
e.Form.Controls("Label6").text = "耗时" & (timeend - timestart).TotalSeconds & "秒"
Messagebox.show("按专业【预估分】分,筛选出符合条件的行,共" & (Tables("基础数据").rows.count) & "行", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
MainTable = Tables("基础数据")
 回到顶部
帅哥哟，离线，有人找我吗？
hbfnmxb
 小大  9楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：二尾狐 帖子：559 积分：6330 威望：0 精华：0 注册：2008/9/7 20:15:00 		  发帖心情 Post By：2024/9/10 15:41:00 [显示全部帖子]

3个按钮，好的，我试一下
 回到顶部
帅哥哟，离线，有人找我吗？
hbfnmxb
 小大  10楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：二尾狐 帖子：559 积分：6330 威望：0 精华：0 注册：2008/9/7 20:15:00 		  发帖心情 Post By：2024/9/10 16:54:00 [显示全部帖子]

3个按钮确实能解决问题，但我还是想用一个按钮，一个按钮更方便些。老师再给看看是哪里的问题！

 回到顶部
总数 14 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.07031 秒, 5 次数据查询