用vb制作一个随机分组程序，求大神帮忙

weixin_44797959 2019-03-19 09:00:31
1.导入人员名单文件，名单人数根据实际确定 2。正常岗位人数固定2人，特殊岗位有3个，这3个岗位分配人数随名单人数变化而变化，岗位人数在1-2人变化 3.实现随机分组，人员不重复 4.输出时显示岗位:姓名
...全文
363 9 打赏 收藏 转发到动态 举报
写回复
用AI写文章
9 条回复
切换为时间正序
请发表友善的回复…
发表回复
weixin_44797959 2019-03-23
  • 打赏
  • 举报
 回复
引用 7 楼 milaoshu1020的回复:
也可以用字典和集合:


Option Explicit



Private mdctSpecial As New Dictionary

Private mdctCommon As New Dictionary

Private mcolSource As New Collection



Private Function GetRandomNumber(ByVal intBegin As Integer, ByVal intEnd As Integer) As Integer

    Randomize

    GetRandomNumber = Int((intEnd - intBegin + 1) * Rnd + intBegin)

End Function



Private Function PickFromSource() As Integer

    Dim intIndex As Integer

    intIndex = GetRandomNumber(1, mcolSource.Count)

    

    PickFromSource = mcolSource.Item(intIndex)

    mcolSource.Remove intIndex

End Function



Private Sub GenerateSourceData()

    Dim intCount As Integer

    intCount = GetRandomNumber(3, 100)

    

    Dim i As Integer

    For i = 1 To intCount

        mcolSource.Add i

    Next

End Sub



Private Sub DevideIntoGroups()

    Set mdctSpecial.Item(1) = New Collection

    Set mdctSpecial.Item(2) = New Collection

    Set mdctSpecial.Item(3) = New Collection



    Select Case mcolSource.Count

    Case 3

        mdctSpecial(1).Add PickFromSource

        mdctSpecial(2).Add PickFromSource

        mdctSpecial(3).Add PickFromSource

    Case 4

        mdctSpecial(1).Add PickFromSource

        mdctSpecial(1).Add PickFromSource

        mdctSpecial(2).Add PickFromSource

        mdctSpecial(3).Add PickFromSource

    Case Else

        If mcolSource.Count Mod 2 = 1 Then

            mdctSpecial(1).Add PickFromSource

            mdctSpecial(1).Add PickFromSource

            mdctSpecial(2).Add PickFromSource

            mdctSpecial(2).Add PickFromSource

            mdctSpecial(3).Add PickFromSource

        Else

            mdctSpecial(1).Add PickFromSource

            mdctSpecial(1).Add PickFromSource

            mdctSpecial(2).Add PickFromSource

            mdctSpecial(2).Add PickFromSource

            mdctSpecial(3).Add PickFromSource

            mdctSpecial(3).Add PickFromSource

        End If

    End Select

    

    Debug.Assert mcolSource.Count Mod 2 = 0

    

    Dim i As Integer

    For i = 1 To mcolSource.Count \ 2

        Set mdctCommon.Item(i) = New Collection

        mdctCommon(i).Add PickFromSource

        mdctCommon(i).Add PickFromSource

    Next

End Sub



Private Sub Form_Load()

    GenerateSourceData

    Debug.Print mcolSource.Count

    

    DevideIntoGroups

    

    Dim varKey As Variant

    For Each varKey In mdctSpecial

        Dim varItem As Variant

        For Each varItem In mdctSpecial(varKey)

            Debug.Print "特殊岗位" & varKey & ": " & "人员" & varItem

        Next

    Next

    

    For Each varKey In mdctCommon

        For Each varItem In mdctCommon(varKey)

            Debug.Print "正常岗位" & varKey & ": " & "人员" & varItem

        Next

    Next

    

    Unload Me

End Sub

运行示例:

下载地址:
链接：https://pan.baidu.com/s/1D8O7gpBH-EsacDOLKxIi2Q
提取码：wcv6
谢谢，看程序运行结果和我所需要的很相近
weixin_44797959 2019-03-23
  • 打赏
  • 举报
 回复
引用 6 楼 脆皮大雪糕的回复:
[quote=引用 5 楼 weixin_44797959 的回复:] 特殊岗位共3个，你这个每组都有特殊岗位，是和你设定的组数有关吗？
从你的描述中并不是很理解你的特殊岗位和正常岗位的关系 你的问题标题是要一个随机分组，给你的例子最根本的就是把人员名单随机打乱，再有一个根据我理解的分组算法输出。 我的算法是每组都有5个人2个正常3个特殊。如果最后一组人数不够，那么优先排正常，再排特殊。 如果分组算法部分不对你自己改咯。[/quote] 可能是我描述的不清楚，我自己改下试试，不行再向你请教
milaoshu1020 2019-03-22
  • 打赏
  • 举报
 回复
也可以用字典和集合:


Option Explicit



Private mdctSpecial As New Dictionary

Private mdctCommon As New Dictionary

Private mcolSource As New Collection



Private Function GetRandomNumber(ByVal intBegin As Integer, ByVal intEnd As Integer) As Integer

    Randomize

    GetRandomNumber = Int((intEnd - intBegin + 1) * Rnd + intBegin)

End Function



Private Function PickFromSource() As Integer

    Dim intIndex As Integer

    intIndex = GetRandomNumber(1, mcolSource.Count)

    

    PickFromSource = mcolSource.Item(intIndex)

    mcolSource.Remove intIndex

End Function



Private Sub GenerateSourceData()

    Dim intCount As Integer

    intCount = GetRandomNumber(3, 100)

    

    Dim i As Integer

    For i = 1 To intCount

        mcolSource.Add i

    Next

End Sub



Private Sub DevideIntoGroups()

    Set mdctSpecial.Item(1) = New Collection

    Set mdctSpecial.Item(2) = New Collection

    Set mdctSpecial.Item(3) = New Collection



    Select Case mcolSource.Count

    Case 3

        mdctSpecial(1).Add PickFromSource

        mdctSpecial(2).Add PickFromSource

        mdctSpecial(3).Add PickFromSource

    Case 4

        mdctSpecial(1).Add PickFromSource

        mdctSpecial(1).Add PickFromSource

        mdctSpecial(2).Add PickFromSource

        mdctSpecial(3).Add PickFromSource

    Case Else

        If mcolSource.Count Mod 2 = 1 Then

            mdctSpecial(1).Add PickFromSource

            mdctSpecial(1).Add PickFromSource

            mdctSpecial(2).Add PickFromSource

            mdctSpecial(2).Add PickFromSource

            mdctSpecial(3).Add PickFromSource

        Else

            mdctSpecial(1).Add PickFromSource

            mdctSpecial(1).Add PickFromSource

            mdctSpecial(2).Add PickFromSource

            mdctSpecial(2).Add PickFromSource

            mdctSpecial(3).Add PickFromSource

            mdctSpecial(3).Add PickFromSource

        End If

    End Select

    

    Debug.Assert mcolSource.Count Mod 2 = 0

    

    Dim i As Integer

    For i = 1 To mcolSource.Count \ 2

        Set mdctCommon.Item(i) = New Collection

        mdctCommon(i).Add PickFromSource

        mdctCommon(i).Add PickFromSource

    Next

End Sub



Private Sub Form_Load()

    GenerateSourceData

    Debug.Print mcolSource.Count

    

    DevideIntoGroups

    

    Dim varKey As Variant

    For Each varKey In mdctSpecial

        Dim varItem As Variant

        For Each varItem In mdctSpecial(varKey)

            Debug.Print "特殊岗位" & varKey & ": " & "人员" & varItem

        Next

    Next

    

    For Each varKey In mdctCommon

        For Each varItem In mdctCommon(varKey)

            Debug.Print "正常岗位" & varKey & ": " & "人员" & varItem

        Next

    Next

    

    Unload Me

End Sub

运行示例:

下载地址:
链接：https://pan.baidu.com/s/1D8O7gpBH-EsacDOLKxIi2Q
提取码：wcv6
脆皮大雪糕 2019-03-21
  • 打赏
  • 举报
 回复
引用 5 楼 weixin_44797959 的回复:
特殊岗位共3个，你这个每组都有特殊岗位，是和你设定的组数有关吗？
从你的描述中并不是很理解你的特殊岗位和正常岗位的关系 你的问题标题是要一个随机分组，给你的例子最根本的就是把人员名单随机打乱，再有一个根据我理解的分组算法输出。 我的算法是每组都有5个人2个正常3个特殊。如果最后一组人数不够，那么优先排正常，再排特殊。 如果分组算法部分不对你自己改咯。
weixin_44797959 2019-03-20
  • 打赏
  • 举报
 回复
引用 3 楼 脆皮大雪糕的回复:

    Const workernum = 20
    Dim aryTestName(1 To workernum) As String
    Dim i As Integer
    Dim strtmp As String
    Dim idx1 As Integer, idx2 As Integer
    '模拟人员塞入数组,这里因为例子少于26个人，所以用字母来区分人员名字
    For i = 1 To workernum
        aryTestName(i) = "人员" & Chr(64 + i)
    Next
    Randomize Now() '弄个随机种子
    
    For i = 1 To 10000 '做10000次随机调序打乱顺序，随机调序的次数建议为数组元素数量的10倍以上
        idx1 = Int(Rnd * (UBound(aryTestName) - LBound(aryTestName) + 1)) + LBound(aryTestName) '生成1个数组下标范围内随机整数
        idx2 = Int(Rnd * (UBound(aryTestName) - LBound(aryTestName) + 1)) + LBound(aryTestName) '再生成1个数组下标范围内随机整数
        '把两个下标对应的数组元素进行对换
        strtmp = aryTestName(idx1)
        aryTestName(idx1) = aryTestName(idx2)
        aryTestName(idx2) = strtmp
    Next
    
    '输出
    For i = LBound(aryTestName) To UBound(aryTestName)
        Debug.Print "第" & Fix((i - 1) / 5) + 1 & "组 " & IIf(((i - 1) Mod 5) < 2, "正常岗位" & ((i - 1) Mod 5) + 1, "特殊岗位" & ((i - 1) Mod 5) - 1) & ":" & aryTestName(i)
    Next
一组输出： 第1组 正常岗位1:人员G 第1组 正常岗位2:人员H 第1组 特殊岗位1:人员C 第1组 特殊岗位2:人员E 第1组 特殊岗位3:人员T 第2组 正常岗位1:人员I 第2组 正常岗位2:人员L 第2组 特殊岗位1:人员S 第2组 特殊岗位2:人员M 第2组 特殊岗位3:人员P 第3组 正常岗位1:人员O 第3组 正常岗位2:人员F 第3组 特殊岗位1:人员N 第3组 特殊岗位2:人员D 第3组 特殊岗位3:人员R 第4组 正常岗位1:人员B 第4组 正常岗位2:人员Q 第4组 特殊岗位1:人员K 第4组 特殊岗位2:人员A 第4组 特殊岗位3:人员J
特殊岗位共3个，你这个每组都有特殊岗位，是和你设定的组数有关吗？
脆皮大雪糕 2019-03-19
  • 打赏
  • 举报
 回复 

    Const workernum = 20
    Dim aryTestName(1 To workernum) As String
    Dim i As Integer
    Dim strtmp As String
    Dim idx1 As Integer, idx2 As Integer
    '模拟人员塞入数组,这里因为例子少于26个人，所以用字母来区分人员名字
    For i = 1 To workernum
        aryTestName(i) = "人员" & Chr(64 + i)
    Next
    Randomize Now() '弄个随机种子
    
    For i = 1 To 10000 '做10000次随机调序打乱顺序，随机调序的次数建议为数组元素数量的10倍以上
        idx1 = Int(Rnd * (UBound(aryTestName) - LBound(aryTestName) + 1)) + LBound(aryTestName) '生成1个数组下标范围内随机整数
        idx2 = Int(Rnd * (UBound(aryTestName) - LBound(aryTestName) + 1)) + LBound(aryTestName) '再生成1个数组下标范围内随机整数
        '把两个下标对应的数组元素进行对换
        strtmp = aryTestName(idx1)
        aryTestName(idx1) = aryTestName(idx2)
        aryTestName(idx2) = strtmp
    Next
    
    '输出
    For i = LBound(aryTestName) To UBound(aryTestName)
        Debug.Print "第" & Fix((i - 1) / 5) + 1 & "组 " & IIf(((i - 1) Mod 5) < 2, "正常岗位" & ((i - 1) Mod 5) + 1, "特殊岗位" & ((i - 1) Mod 5) - 1) & ":" & aryTestName(i)
    Next
一组输出： 第1组 正常岗位1:人员G 第1组 正常岗位2:人员H 第1组 特殊岗位1:人员C 第1组 特殊岗位2:人员E 第1组 特殊岗位3:人员T 第2组 正常岗位1:人员I 第2组 正常岗位2:人员L 第2组 特殊岗位1:人员S 第2组 特殊岗位2:人员M 第2组 特殊岗位3:人员P 第3组 正常岗位1:人员O 第3组 正常岗位2:人员F 第3组 特殊岗位1:人员N 第3组 特殊岗位2:人员D 第3组 特殊岗位3:人员R 第4组 正常岗位1:人员B 第4组 正常岗位2:人员Q 第4组 特殊岗位1:人员K 第4组 特殊岗位2:人员A 第4组 特殊岗位3:人员J
milaoshu1020 2019-03-19
  • 打赏
  • 举报
 回复
请问3个特殊岗位是不是都得派人(至少派1个人)?
脆皮大雪糕 2019-03-19
  • 打赏
  • 举报
 回复
把人员导入，然后随机排序，完事以后按你的人员数量要求，要几个人就按顺序抓几个人出来就行
weixin_44797959 2019-03-19
  • 打赏
  • 举报
 回复
引用 2 楼 milaoshu1020的回复:
请问3个特殊岗位是不是都得派人(至少派1个人)?
对，特殊岗位最少1人，名单人员足够多就和正常岗位一样2人，不满足就安排1人
VB串口通信源码210个
086、vb用控件的写的串口程序，是vb的经典之作 087、VB与USB转串口的通讯完整程序,有详细说明,不需要安装驱动 088、vb与串口通信的关于回路测试的小程序很实用 089、vb语言开发的串口通信，可实现拨号传送文件等 090...
VB 打包利器 Setup Factory 7.0
一款专为VB6.0 开发而制作的打包工具：Setup Factory 7.0 ，它具有：功能强大、操作简单、界面美观、打出来的包体积小，安装速度快捷的特点。
PowerDesigner使用教程
利用PowerDesigner可以制作数据流程图、概念数据模型、物理数据模型，可以生成多种客户端开发工具的应用程序，还可为数据仓库制作结构模型，也能对团队设计模型进行控制。它可与许多流行的数据库设计软件，例如：...
最强悍的 VC VB反编译工具 Hex-Rays
最强悍的反编译工具 Hex-Rays。可以反编译 VB VC BCB Delphi 等等一切 x86/x64 代码为 C 代码。密码参见内附说明文件。我写了个简单的介绍 http://blog.caozhongyan.com/article.asp?id=19
DirectX修复工具V4.3增强版
DirectX修复工具(DirectX Repair)是一款系统级工具软件，简便易用。 本程序的主要功能是检测当前系统的DirectX状态，如果发现异常则进行修复。程序主要针对0xc000007b问题设计，可以完美修复该问题。本程序中包含...
VB基础类

7,764

社区成员

197,605

社区内容

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章