场景:
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
umber
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