[Vbscript]_[初级]_[分组程序]

说明

1. 之前写了一个vbscript的分组程序，目的是给公司里的人员活动时随机分成N个组。活动随机分组小程序-VBS. 但是这个程序有BUG，也不能修改资源。这里做了新的版本修复。

例子

文件1：随机分组.vbs

1. 使用Windows的记事本打开，之后复制一下的文本到记事本，保存为随机分组.vbs, 注意后缀名必须是.vbs，存储时选择编码为ANSI， 这样弹出窗口的文字才不会显示乱码。

' 随机分组 author: Sai
' 新建一个ansi编码的txt文件, 名字为 姓名.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

   Dim one	
   one = i\number 
   
   Dim le
   le = i Mod number
     
'   Wscript.echo "分组: " & number
'   Wscript.echo "人数: " & i
'   Wscript.echo "人数: " & UBound(a1)+1
'   Wscript.echo "每组人数: " & one

   Dim groupMember()
   ReDim Preserve groupMember(i+number)
   
   Dim g1,j1
   g1 = 0
   j1 = 1

   Dim total
   total = i+number
   Randomize
   While g1 < total   		
        groupMember(g1) = "----第 " & j1 & " 组----"
        f.WriteLine groupMember(g1)
        g1 = g1 +1
        
        f.WriteLine groupMember(g1)
   		For n = 1 To one
   		    randJ = Int((UBound(a1)+1) * Rnd)   ' Generate random value between 0 and UBound(a1).
   			groupMember(g1) = a1(randJ)
   			f.WriteLine groupMember(g1)
   			
   			g1 = g1 + 1
   			DeleteArray a1,randJ
   		Next
   		
        If le > 0 Then
        	randJ = Int((UBound(a1)+1) * Rnd)
        	groupMember(g1) = a1(randJ)
   			f.WriteLine groupMember(g1)
   			g1 = g1 +1
        	DeleteArray a1,randJ
        	le = le -1
        End If
        j1 = j1 +1
   Wend      
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

1. 新建一个ANSI编码的文档，之后存储姓名，一个姓名一行，名称以@开头

-- 注意,有效的姓名以@开头 -- 

-- 开发部门 --
@张三1
@张三2

-- 行政部门 --
@张三3
@张三4
@张三5

-- 营销部门 --
@张三6
@张三7
@张三8
@张三9
@张三10
@张三11
@张三12

@张三13

运行

1. 双击随机分组.vbs, 会生成一个分组结果.txt的文档。
   
2. 分组结果.txt

----第 1 组----

张三4
张三8
----第 2 组----

张三2
张三10
----第 3 组----

张三9
张三5
----第 4 组----

张三13
张三1
----第 5 组----

张三6
张三12
----第 6 组----

张三11
----第 7 组----

张三7
----第 8 组----

张三3

下载地址

我设置的0分，可能由于优快云自动更改下载积分不管我的事，可能还在审核打不开。
自动分组第二版