华兵实验中学

华兵实验中学

-

2023年2月14日发(作者：)

Excel在运动会径赛项目中的运用

发表时间：2014-06-20T10:08:41.950Z来源：《素质教育》2014年3月总第148期供稿作者：邸江峰

[导读]径赛项目如初一女子60米预决赛，裁判组会将本项成绩送来。秘书组首先要做的就是将成绩录入，以期后面排序。

邸江峰新疆华兵实验中学830000

在校运动会秘书处算名次三年了，从开始尝试用VBA解决到现在已经比较成熟。

一、横变竖

径赛项目如初一女子60米预决赛，裁判组会将本项成绩送来。秘书组首先要做的就是将成绩录入，以期后面排序。录成绩时，可以拷

贝总名单里现成的运动员分组数据，并完成横变竖。怎样将运动员分组数据变成竖排的呢。就是所有的运动员号在一列中。只需要从控件

工具箱里拖出一个按钮，写以下代码就可以。

PrivateSub横变数_Click()

Fori=2ToRange(\"k65536\").End(xlUp).Row/K行是用来存放结果的。意思就是遍历K行。

Cells(i,11)=Null/将K行和L行清空Cells(i,12)=Null/意思就是将上次横变数的结果清空。

Next/目的是尽量减少手工操作。

lie=Range(\"iv1\").End(xlToLeft).Column/看下第一行数据有几列。就是几个道次。

hang=Range(\"A65536\").End(xlUp).Row/看下第一列有几行。就是分的几组。

Fori=2Tohang/遍历所有组中的运动员号码。

Forj=2Tolie/遍历所有道次中运动员的号码。

IfCells(i,j)>0Then/如果单元格中有空白的就放弃。

Cells(m+2,11)=Cells(i,j)/从K2单元格开始往下放置运动员号码。

m=m+1EndIfNextNextEndSub

这样做的目的是用程序完成排序做准备。省却了录入运动员号码的麻烦。EXCEL中粘贴时可以用选择性粘贴中的“转置”，但是需要多

次操作。在横变竖时，甚至都不用选择单元格但是要保证运动员分组数据拷贝位置从单元格A1开始，行列标题都不能有空。

二、求名次

不用选择不用排序，只需要一个按钮，就在不动号码顺序的情况下算出各运动员的名次、道次、班级奖励分。横变竖后，录入成绩后

得到一组数据。怎样在不选择、不排序的情况下直接得到名次、道次、奖励分。不改变顺序的目的是利于检察录入是否有误，以防万一。

求名次的程序：

PrivateSub求名次_Click()

Forj=2ToRange(\"b65536\").End(xlUp).Row/B列是成绩行。用来确定共有几行成绩。

x=1/比较前所有成绩都是第一名。

Fori=2ToRange(\"b65536\").End(xlUp).Row/行内所有数据遍历。循环行数×行数。

IfCells(j,2)>Cells(i,2)Then/冒泡法。

x=x+1/被比较数大于别的数的时候名次靠后。

EndIfNextCells(j,3)=x/该成绩跟其他成绩比较一遍后，确定自己的名次NextEndSub。

三、分道次

求名次后求道次就方便多了，就是根据名次定道次。以下是有八道时候的程序。

PrivateSub分八道_Click()

Fori=2ToRange(\"b65536\").End(xlUp).Row/确定有几个运动员。

SelectCaseCells(i,3)/根据名次确定道次。

Case1Cells(i,4)=4/第一名是第4道。

Case2Cells(i,4)=5/第二名是第五道。

Case3Cells(i,4)=3/以此类推。

Case4Cells(i,4)=6

Case5Cells(i,4)=2

Case6Cells(i,4)=7

Case7Cells(i,4)=1

Case8Cells(i,4)=8

CaseElseCells(i,4)=NullEndSelectNextEndSub

有人说，为什么不把分道次的程序和求名次的程序合成到一起。那是因为，有时候要分6道或者4道。

四、求班级奖励分

求班级奖励分要分团体和个人。个人第一名到第八名的班级奖励分分别是9、7、6、5、4、3、2、1。团体是指集体项目，如接力，班

级奖励分是个人项目的两倍。程序结构同分道次一致，这里不再赘述。

五、排序

为了便于直观地看到比赛结果，还是需要将原始顺序按照成绩排序，并顺带拷贝对应的名次、道次、奖励分。

PrivateSub排序_Click()

Fori=2ToRange(\"f65536\").End(xlUp).Row/确定旧数据有几行。

Forj=6To10/是G行到K行。

Cells(i,j)=Null/清空旧数据。

NextNextFori=2ToRange(\"A65536\").End(xlUp).Row/确定新数据有几行。

Forj=1To5Cells(i,j+6)=Cells(i,j)/整个拷贝到新位置。

NextNextForm=2ToRange(\"A65536\").End(xlUp).Row1/所有成绩。

Fori=2ToRange(\"A65536\").End(xlUp).Row1/该成绩跟其它成绩比对一遍，不用跟自己比。

IfCells(i,9)>Cells(i+1,9)Then/如果名次靠后Forj=7To11/拷贝该运动员所有数据。

x=Cells(i,j)Cells(i,j)=Cells(i+1,j)Cells(i+1,j)=x/用空变量X，完成两运动员信息位置的置换。