1.匯入人員名單檔案,名單人數根據實際確定
2。正常崗位人數固定2人,特殊崗位有3個,這3個崗位分配人數隨名單人數變化而變化,崗位人數在1-2人變化
3.實作隨機分組,人員不重復
4.輸出時顯示崗位:姓名
uj5u.com熱心網友回復:
把人員匯入,然后隨機排序,完事以后按你的人員數量要求,要幾個人就按順序抓幾個人出來就行uj5u.com熱心網友回復:
請問3個特殊崗位是不是都得派人(至少派1個人)?uj5u.com熱心網友回復:
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
uj5u.com熱心網友回復:
對,特殊崗位最少1人,名單人員足夠多就和正常崗位一樣2人,不滿足就安排1人
uj5u.com熱心網友回復:
特殊崗位共3個,你這個每組都有特殊崗位,是和你設定的組數有關嗎?
uj5u.com熱心網友回復:
從你的描述中并不是很理解你的特殊崗位和正常崗位的關系
你的問題標題是要一個隨機分組,給你的例子最根本的就是把人員名單隨機打亂,再有一個根據我理解的分組演算法輸出。
我的演算法是每組都有5個人2個正常3個特殊。如果最后一組人數不夠,那么優先排正常,再排特殊。
如果分組演算法部分不對你自己改咯。
uj5u.com熱心網友回復:
也可以用字典和集合:
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
uj5u.com熱心網友回復:
可能是我描述的不清楚,我自己改下試試,不行再向你請教
uj5u.com熱心網友回復:
也可以用字典和集合:
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
謝謝,看程式運行結果和我所需要的很相近
轉載請註明出處,本文鏈接:https://www.uj5u.com/gongcheng/36949.html
標籤:VB基礎類
上一篇:無聊
