手把手教你用excel做一套电脑派位摇号系统.docx
- 文档编号:441371
- 上传时间:2022-10-10
- 格式:DOCX
- 页数:10
- 大小:537.35KB
手把手教你用excel做一套电脑派位摇号系统.docx
《手把手教你用excel做一套电脑派位摇号系统.docx》由会员分享,可在线阅读,更多相关《手把手教你用excel做一套电脑派位摇号系统.docx(10页珍藏版)》请在冰豆网上搜索。
手把手教你用excel做一套电脑派位摇号系统
手把手教你用excel做一套电脑派位摇号系统
首先说下这套电脑摇号派位的原理,一共分四步,第一步首先将需要摇号派位的学生信息收集完整,按照报名序号、姓名、性别及家长信息等原始信息放入一个excel表中。
第二步,给每个学生生成一个随机号,这个随机号是电脑随机生成,每个学生不同。
第三步,通过掷硬币或者找家长抽签的方式,确定录取的方式,是从大号到小号录取,还是从小号到大号录取,第四步,按照抽签确定的顺序排序录取一定数量的学生,到此录取全部完成。
之所以用excel来做,就是因为excel的VBA实现排序的功能很方便,源码所见所得,容易查询,也很容易公开查询。
下面来一点点的实现。
一、软件打开动画
首先打开excel,打开VBA,插入一个窗体,设置5秒倒计时消失。
核心代码如下:
PrivateSubUserForm_Initialize()
ltime.Caption=5
Callb
EndSub
二、主窗体设计
基本功能都在此界面内完成,其实也简单,就是使用excel表格的大部分功能,然后右侧加入需要的功能按钮。
这里为了更加公平,加入了两次生成随机数,两次排序,杜绝作弊。
大家看下右侧的按钮,我们一点点来做。
1.首先来做第一个查询窗口,点击查询记录,会跳出一个查询。
代码如下:
Sub查询()
UserForm1.Show
EndSub
在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
EndSub
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 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 Nexti Range("f2: f"&count+1).Value=arr MsgBox"生成随机号完成" EndSub 3.按照生成的随机数排序,抽签或者掷硬币确定排序顺序。 排序的代码: Sub从小到大() ' Cells.Select ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Addkey: =Range("f2: f292")_ SortOn: =xlSortOnValues,Order: =xlAscending,DataOption: =xlSortNormal WithActiveWorkbook.Worksheets("Sheet1").Sort .SetRangeRange("A1: h301") .Header=xlYes .MatchCase=False .Orientation=xlTopToBottom .SortMethod=xlPinYin .Apply EndWith MsgBox"从小到大排序完成" EndSub Sub从大到小() Cells.Select ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Addkey: =Range("f2: f292")_ SortOn: =xlSortOnValues,Order: =xlDescending,DataOption: =xlSortNormal WithActiveWorkbook.Worksheets("Sheet1").Sort .SetRangeRange("A1: h301") .Header=xlYes .MatchCase=False .Orientation=xlTopToBottom .SortMethod=xlPinYin .Apply EndWith MsgBox"从大到小排序完成" EndSub 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&"录取" Next [e2].Resize(d.count,1)=brr Setd=Nothing EndSub 后面还有打印录取名单和重置按钮,代码一并奉上。 Sub打印_Click()'打印到录取的50人 Range("A1: H51").Select Selection.PrintOutCopies: =1 EndSub Subchongzhi()'重置 Cells.Select ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Addkey: =Range("A2: A500")_ SortOn: =xlSortOnValues,Order: =xlAscending,DataOption: =_ xlSortTextAsNumbers WithActiveWorkbook.Worksheets("Sheet1").Sort .SetRangeRange("A1: DG500") .Header=xlYes .MatchCase=False .Orientation=xlTopToBottom .SortMethod=xlPinYin .Apply EndWith EndSub 优点: 程序间接,整个派位过程由家长代表或公证人员参与,摇号派位过程可以互动参与,源代码可以在摇号前或者摇号后实时公布,方便快捷,公平公正。
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 手把手 excel 一套 电脑 派位摇号 系统