手把手教你用excel做一套电脑派位摇号系统Word文档下载推荐.docx
《手把手教你用excel做一套电脑派位摇号系统Word文档下载推荐.docx》由会员分享，可在线阅读，更多相关《手把手教你用excel做一套电脑派位摇号系统Word文档下载推荐.docx（10页珍藏版）》请在冰豆网上搜索。
大家看下右侧的按钮，我们一点点来做。
1.首先来做第一个查询窗口，点击查询记录，会跳出一个查询。
代码如下：
Sub查询（）
UserForm1.Show
在VBA中添加窗体，窗体中加入各控件，
给查询按钮加入事件：
PrivateSubCommandButton1_Click（）'
查询
DimMYRANGEAsRange
DimiAsInteger
SetMYRANGE=Sheets（"
SHEET1"
）.Range（"
a2"
Range（"
A65536"
）.End（xlUp））.Find（TextBox10.Value）'
在excel中查找相同的数据
IfNotMYRANGEIsNothingThen
Fori=1To8
Me.Controls（"
TEXTBOX"
&
i）=Cells（MYRANGE.Row,i）
Nexti
Else
MsgBox"
没有找到！
"
TextBox10
EndIf
2.做第一个随机数生成
给图中按钮加入事件代码：
Sub随机号生成（）'
生成8位的不相同的随机数
DimiAsLong,t0,dict,keyAsLong,key_countAsLong
DimlowAsLong,highAsLong,diffAsLong,countAsLong,tryAsCurrency
t0=Timer
[f2:
f501].Clear'
清空
low=10000000
high=99999999
count=291
try=100*count
Ifhigh<
lowThenhigh=low:
low=1
diff=high-low
Ifdiff<
=countThencount=diff+1
Setdict=CreateObject（"
Scripting.Dictionary"
）
ReDimarr（1Tocount,1To1）
Randomize
Fori=1Totry
key=Round（Rnd*diff+low,0）
IfNotdict.exists（key）Then
key_count=key_count+1
arr（key_count,1）=key
dict.Addkey,"
Else
'
donothing
EndIf
Ifkey_count>
=countThenExitFor
Range（"
f2:
f"
count+1）.Value=arr
生成随机号完成"
3.按照生成的随机数排序，抽签或者掷硬币确定排序顺序。
排序的代码：
Sub从小到大（）
'
Cells.Select
ActiveWorkbook.Worksheets（"
Sheet1"
）.Sort.SortFields.Clear
）.Sort.SortFields.Addkey:
=Range（"
f292"
）_
SortOn:
=xlSortOnValues,Order:
=xlAscending,DataOption:
=xlSortNormal
WithActiveWorkbook.Worksheets（"
）.Sort
.SetRangeRange（"
A1:
h301"
.Header=xlYes
.MatchCase=False
.Orientation=xlTopToBottom
.SortMethod=xlPinYin
.Apply
EndWith
MsgBox"
从小到大排序完成"
Sub从大到小（）
=xlDescending,DataOption:
从大到小排序完成"
3.继续生成第二次随机数
代码复用，和第一次随机数代码相同。
4.抽签或者掷硬币，确定录取顺序，我演示的是按照从小到大的顺序录取50名。
代码：
Sub录取（）
Dimarr,brr,myrow&
k&
i&
d
Setd=CreateObject（"
scripting.dictionary"
arr=Range（"
d2:
d"
Cells（Rows.count,4）.End（3）.Row）
ReDimbrr（1ToUBound（arr）,1To1）
Fori=1ToUBound（arr）
d（arr（i,1））=i
Next
Fori=1To50
myrow=Application.Small（arr,i*5-4）
k=k+1
brr（d（myrow）,1）="
第"
k&
"
录取"
[e2].Resize（d.count,1）=brr
Setd=Nothing
后面还有打印录取名单和重置按钮，代码一并奉上。
Sub打印_Click（）'
打印到录取的50人
Range（"
H51"
）.Select
Selection.PrintOutCopies:
=1
Subchongzhi（）'
重置
A2:
A500"
=_
xlSortTextAsNumbers
DG500"
优点：
程序间接，整个派位过程由家长代表或公证人员参与，摇号派位过程可以互动参与，源代码可以在摇号前或者摇号后实时公布，方便快捷，公平公正。
升级会员 