求大神帮忙解决一个随机分组问题

后来的我们888 2020-05-17 08:37:17

公司组织售后回访组人员进行售后登门调查活动，从800家客户中，随机抽出50家客户。售后回访组共16个人，随机分配2人一组，对50家客户进行售后登门调查活动，在access表中，有回访组16人的人员目录，以及800家客户的目录。用vb6如何从数据中随机提取出50家客户，然后把16人按随机2人一组，分配给50家客户，并从窗体上用datagrid或mshflexgird显示出来。有没有大神能够解决这个难题。脑筋想破了也没想出来，好难。

...全文

535 20 打赏收藏转发到动态举报

写回复

用AI写文章

20 条回复

切换为时间正序

请发表友善的回复…

发表回复

milaoshu1020 2020-05-28

打赏
举报

没关系,这个帖子的分给我也行: https://bbs.csdn.net/topics/396599283 这回别错了;

后来的我们888 2020-05-28

打赏
举报

刚才明明是分给的15楼，晕掉

后来的我们888 2020-05-28

打赏
举报

15楼牛人！！！

lx3275852 2020-05-25

打赏
举报

数据库里随机选可以参考这个sql语句 select * from t order by rand() limit 1,50; 意思就是根据随机数排序，选前50个……rand()是随机数函数，根据自己的数据库换函数名。。。当然选16人也可以同样方式。最后把16人分成8组，每组2人，再把50个客户分给他们，可以在程序中实现，比较简单了。。。

后来的我们888 2020-05-22

打赏
举报

厉害厉害！！明天调试一下，看看能运行不。

milaoshu1020 2020-05-22

打赏
举报

写好了,不过你可能需要再修改,现在不能保证每个售后都有客户: Form1:


Option Explicit

Private Sub Command1_Click()
    Dim cn As New Connection
    cn.Open "provider=microsoft.jet.oledb.4.0;data source=" & App.Path & "\database1.mdb"
    
    cn.Execute "delete * from shouhou;"
    
    Dim rs As New Recordset
    rs.Open "select * from shouhou;", cn, adOpenKeyset, adLockOptimistic
    
    Dim i As Long
    For i = 1 To 16
        rs.AddNew
        rs!shouhou = "售后" & i
        rs.Update
    Next

    cn.Execute "delete * from kehu;"
    
    rs.Close
    rs.Open "select * from kehu;", cn, adOpenKeyset, adLockOptimistic
    
    For i = 1 To 800
        rs.AddNew
        rs!kehu = "客户" & i
        rs.Update
    Next

    MsgBox "初始化完成!"
End Sub

Private Sub Command2_Click()
    Form2.Show
End Sub

Form2:


Option Explicit

Private mobjRecordset As New Recordset
Private mobjConnection As New Connection

Private Sub Check1_Click()
    Timer1.Enabled = (Check1.Value = vbChecked)
End Sub

Private Sub Form_Load()
    mobjConnection.Open "provider=microsoft.jet.oledb.4.0;data source=" & App.Path & "\database1.mdb"
    mobjRecordset.Open "select * from huifang;", mobjConnection, adOpenKeyset, adLockOptimistic
    Set Adodc1.Recordset = mobjRecordset
    Adodc1.Refresh
End Sub

Private Sub Form_Unload(Cancel As Integer)
    mobjRecordset.Close
    mobjConnection.Close
End Sub

Private Sub Calc()
    ' 读取客户数据到集合;
    Dim rs As New Recordset
    rs.Open "select * from kehu;", mobjConnection, adOpenKeyset, adLockOptimistic
    
    Dim colKehu As New Collection
    
    rs.MoveFirst
    While Not rs.EOF
        Dim objKehu As CKehu
        Set objKehu = New CKehu
        objKehu.mstrName = rs!kehu
        
        colKehu.Add objKehu
        rs.MoveNext
    Wend
    
    rs.Close
    
    ' 读取售后数据到集合;
    rs.Open "select * from shouhou;", mobjConnection, adOpenKeyset, adLockOptimistic
    
    Dim colShouhou As New Collection
    
    rs.MoveFirst
    While Not rs.EOF
        Dim objShouhou As CShouhou
        Set objShouhou = New CShouhou
        objShouhou.mstrName = rs!shouhou
        
        colShouhou.Add objShouhou
        rs.MoveNext
    Wend
    
    rs.Close
    
    ' 随机得到50个客户;
    Dim colResult As New Collection
    Dim i As Long
    For i = 1 To 50
        Dim lngIndex As Long
        lngIndex = GetRnd(1, colKehu.Count)
        Set objKehu = colKehu(lngIndex)
        
        ' 随即得到一个客户,并从客户集合中移除;
        colResult.Add objKehu
        colKehu.Remove lngIndex
        
        Do
            ' 随即得到1个售后;
            lngIndex = GetRnd(1, colShouhou.Count)
            Set objShouhou = colShouhou(lngIndex)
            
            ' 如果两个售后不重复就加入客户的售后字典;
            If Not objKehu.mdctShouhou.Exists(objShouhou.mstrName) Then
                ' 添加客户的售后;
                objKehu.mdctShouhou.Add objShouhou.mstrName, Null
                ' 添加售后的客户;
                objShouhou.mdctKehu.Add objKehu.mstrName, Null
                
                ' 如果售后的客户数量大于等于8,就将该售后从售后集合中移除;
                If objShouhou.mdctKehu.Count >= 8 Then
                    colShouhou.Remove lngIndex
                End If
                
                ' 如果客户的售后数量大于等于2,就中止计算该客户的售后;
                If objKehu.mdctShouhou.Count >= 2 Then
                    Exit Do
                End If
            End If
        Loop
    Next
    
    ' 将计算结果写入数据库;
    mobjConnection.Execute "delete * from huifang;"
    
    rs.Open "select * from huifang;", mobjConnection, adOpenKeyset, adLockOptimistic
    
    For i = 1 To colResult.Count
        Set objKehu = colResult(i)
        
        Dim varKeys As Variant
        varKeys = objKehu.mdctShouhou.Keys
        
        rs.AddNew
        rs!shouhou1 = varKeys(0)
        rs!shouhou2 = varKeys(1)
        rs!kehu = objKehu.mstrName
        rs.Update
    Next
End Sub

' 得到指定范围内的随机数;
Private Function GetRnd(ByVal intStart As Integer, ByVal intEnd As Integer) As Integer
    Randomize
    GetRnd = Int(Rnd() * (intEnd - intStart + 1)) + intStart
End Function

Private Sub Timer1_Timer()
    Calc
    mobjRecordset.Requery
    Adodc1.Refresh
End Sub

CKehu:


Option Explicit

Public mstrName As String
Public mdctShouhou As New Dictionary

CShouhou:


Option Explicit

Public mstrName As String
Public mdctKehu As New Dictionary

下载地址: 链接：https://pan.baidu.com/s/1Q8oOmWVIeBWS9fF3pqyGdw 提取码：mry7 运行示例:

后来的我们888 2020-05-21

打赏
举报

@milaoshu1020 大神，分组不固定。极限情况限制一下，每人最多不能对应超过8个客户。哪位大佬能贴段代码上来，供我参考一下

数据库名huifang 表1-kehu 字段 kehu 表2-shouhou -字段shouhou

脆皮大雪糕 2020-05-20

打赏
举报

1、从数据库中select 所有客户的ID 出来 2、从数据集中随机抽50个ID 两种办法： 2.1 随机生成1~800的整数出来，然后取对应的记录，但是有可能发生重复的问题，要控制 2.2 将所有的ID随机打乱顺序，然后取前50个ID。效率最高又简单的随机打乱算法去搜 knuth洗牌算法 3、同样的原理，将16人随机打乱顺序 4、由于客户和回访组成员都已经随机打乱顺序，接下来就是简单的按顺序，两个回访成员一组，然后算好每组要几个客户按顺序分配干净就是你想要的结果。

milaoshu1020 2020-05-20