場景:

1.每次搞活動都需要分組，比如20個人分3個組，如何才能更公平的分組，想到的只能是隨機分組程序。

2.時間關系并沒有實現男女平衡的分組，有時間的哥們可以自己實現。

文件1：分組程序.vbs,記得保存為ansi編碼.

' 隨機分組 author: Sai ' 新建一個ansi編碼的txt文件,內容是每個姓名占用一行.Sub DeleteArray(arr,i)If UBound(arr) > 0 Thenmax_j = UBound(arr) - 1For j = i To max_jarr(j) = arr(j+1)NextReDim Preserve arr(max_j)End if End SubSub RandomGroup(NameFile,GroupFile)Dim numbernumber = InputBox("請輸入分組個數:"&vbCr&vbCr&" ") If number = 0 Thennumber = 1End IfDim fso, ts, s,fDim a1(),iConst ForReading = 1,ForWriting = 2Set fso = CreateObject("Scripting.FileSystemObject")Set ts = fso.OpenTextFile(NameFile, ForReading)Set f = fso.OpenTextFile(GroupFile, ForWriting, True)i = 0Dos = ts.ReadLineIf Left(s,1) = "@" ThenReDim Preserve a1(i)a1(i) = Mid(s, 2, Len(s)-1)i = i + 1End IfLoop Until ts.AtEndOfStream = True ts.Close' Wscript.echo "分組: " & number ' Wscript.echo "人數: " & i ' Wscript.echo "人數: " & UBound(a1)+1 ' Wscript.echo "每組人數: " & oneDim one one = i\numberDim groupMember()ReDim Preserve groupMember(i+number)Dim g1,j1g1 = -1j1 = 1RandomizeFor j = 0 To UBound(a1)randJ = Int((UBound(a1)+1) * Rnd) ' Generate random value between 0 and UBound(a1).g1 = g1+1If j Mod one = 0 ThengroupMember(g1) = "----第 " & j1 & " 組----" ' Wscript.echo groupMember(g1)f.WriteLine groupMember(g1)g1 = g1+1j1 = j1+1End IfgroupMember(g1) = a1(randJ) ' Wscript.echo groupMember(g1)f.WriteLine groupMember(g1)' 刪除數組元素DeleteArray a1,randJNextEnd SubSet objFSO = CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.GetFile(Wscript.scriptfullname) strFolder = objFSO.GetParentFolderName(objFile) NameFile = strFolder & "\\姓名.txt" GroupFile = strFolder & "\\分組結果.txt" RandomGroup NameFile,GroupFileSet so=CreateObject("WScript.Shell") so.Exec "notepad.exe " & GroupFile

文件2：姓名.txt 記得保存為ansi編碼

-- 注意,有效的姓名以@開頭 -- -- 開發部門 -- @張三1 @張三2 -- 行政部門 -- @張三3 @張三4 @張三5-- 營銷部門 -- @張三6 @張三7 @張三8 @張三9 @張三10 @張三11 @張三12 @張三13

運行完.vbs文件后會自動生成一個分組結果.txt 并自動打開，如果不能平均分組會生成一個新的分組。

比如:

----第 1 組---- 張三2 張三7 張三5 張三10 ----第 2 組---- 張三1 張三12 張三8 張三4 ----第 3 組---- 張三9 張三13 張三3 張三11 ----第 4 組---- 張三6

完整程序下載地址：

http://download.csdn.net/detail/infoworld/6587053

總結

以上是生活随笔為你收集整理的[VBS]_[活动分组程序]的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。