[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