[VBS]_[活动分组程序]
场景:
1.每次搞活动都需要分组,比如20个人分3个组,如何才能更公平的分组,想到的只能是随机分组程序。
2.时间关系并没有实现男女平衡的分组,有时间的哥们可以自己实现。
文件1:分组程序.vbs,记得保存为ansi编码.
' 随机分组 author: Sai ' 新建一个ansi编码的txt文件,内容是每个姓名占用一行. Sub DeleteArray(arr,i) If UBound(arr) > 0 Then max_j = UBound(arr) - 1 For j = i To max_j arr(j) = arr(j+1) Next ReDim Preserve arr(max_j) End if End Sub Sub RandomGroup(NameFile,GroupFile) Dim number number = InputBox("请输入分组个数:"&vbCr&vbCr&" ") If number = 0 Then number = 1 End If Dim fso, ts, s,f Dim a1(),i Const ForReading = 1,ForWriting = 2 Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.OpenTextFile(NameFile, ForReading) Set f = fso.OpenTextFile(GroupFile, ForWriting, True) i = 0 Do s = ts.ReadLine If Left(s,1) = "@" Then ReDim Preserve a1(i) a1(i) = Mid(s, 2, Len(s)-1) i = i + 1 End If Loop Until ts.AtEndOfStream = True ts.Close ' Wscript.echo "分组: " & number ' Wscript.echo "人数: " & i ' Wscript.echo "人数: " & UBound(a1)+1 ' Wscript.echo "每组人数: " & one Dim one one = i\number Dim groupMember() ReDim Preserve groupMember(i+number) Dim g1,j1 g1 = -1 j1 = 1 Randomize For j = 0 To UBound(a1) randJ = Int((UBound(a1)+1) * Rnd) ' Generate random value between 0 and UBound(a1). g1 = g1+1 If j Mod one = 0 Then groupMember(g1) = "----第 " & j1 & " 组----" ' Wscript.echo groupMember(g1) f.WriteLine groupMember(g1) g1 = g1+1 j1 = j1+1 End If groupMember(g1) = a1(randJ) ' Wscript.echo groupMember(g1) f.WriteLine groupMember(g1) ' 删除数组元素 DeleteArray a1,randJ Next End Sub Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.GetFile(Wscript.scriptfullname) strFolder = objFSO.GetParentFolderName(objFile) NameFile = strFolder & "\\姓名.txt" GroupFile = strFolder & "\\分组结果.txt" RandomGroup NameFile,GroupFile Set 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
posted on 2013-11-21 16:51 love so much 阅读(360) 评论(0) 编辑 收藏 举报