excel自动计算体育成绩
生活中经常有一些体育项目，作为学生有一年一度的体育测试，还有田径赛等。人们常常是把体育成绩填到excel中，但是每次项目都很多，且每一个项目的评分标准都不一样，加上每次参加的人也是很多，如果用人工根据评分标准来计算成绩，那工作量是不能想像的。要是在excel中输入成绩了，对应的成绩就自动出来，会方便很多。下面是我写了一个简单的vba程序，实现该功能。
一个评分标准表：
在模块上写计算成绩的公共函数。
因为像跑步类型的体育项目是成绩越高，分数反而越低；而想仰卧起坐类型的体育项目是成绩越高，分数就越高；所以在公共模块里写了对应的两个公共函数。代码如下：
'公共函数
'像跑步类似的成绩越高分越低的
'currentColumn:当前成绩列.
'StandardColumn:当前评分标准列
'a：评分标准起始行
'b：评分标准起始行
'target:当前的sheet
'sheetName：当前评分标准的表名
Public Function autoCalculationASC(target As Range, sheetName As String, currentColumn As Integer, StandardColumn As Integer, a As Integer, b As Integer)
For i = a To b
'先判断成绩是否为空，接着判断评分表格是否为空，
'不为空则判断成绩是否和评分标准相同，
'不同则判断是否低于该表格的评分标准
If Cells(target.Row, currentColumn) = "" Then
Cells(target.Row, currentColumn + 1) = ""
Else
If Sheets(sheetName).Cells(i, StandardColumn) <> "" Then '判断是否为空
'判断是否超出范围
If Cells(target.Row, currentColumn) > Sheets(sheetName).Cells(b, StandardColumn) Then
Cells(target.Row, currentColumn + 1) = 0
Exit For
End If
If Cells(target.Row, currentColumn) = Sheets(sheetName).Cells(i, StandardColumn) Then '判断是否和评分标准相等
Cells(target.Row, currentColumn + 1) = Sheets(sheetName).Cells(i, 1)
Exit For
Else
If Cells(target.Row, currentColumn) < Sheets(sheetName).Cells(i, StandardColumn) Then
'是否是满分
If i = 2 Then
Cells(target.Row, currentColumn + 1) = Sheets(sheetName).Cells(2, 1)
Exit For
End If
Cells(target.Row, currentColumn + 1) = Sheets(sheetName).Cells(i - 1, 1)
Exit For
End If
End If
End If
End If
Next i
'求和
Call sumScore(target)
End Function
'像仰卧起坐类型的成绩越高分越高的
'currentColumn:当前成绩列.
'StandardColumn:当前评分标准列
'a：评分标准起始行
'b：评分标准起始行
'target:当前的sheet
'sheetName：当前评分标准的表名
Public Function autoCalculationDSC(target As Range, sheetName As String, currentColumn As Integer, StandardColumn As Integer, a As Integer, b As Integer)
For i = a To b
'先判断成绩是否为空，接着判断评分表格是否为空，
'不为空则判断成绩是否和评分标准相同，
'不同则判断是否低于该表格的评分标准
If Cells(target.Row, currentColumn) = "" Then
Cells(target.Row, currentColumn + 1) = ""
Else
If Sheets(sheetName).Cells(i, StandardColumn) <> "" Then '判断是否为空
'判断是否超出范围
If Cells(target.Row, currentColumn) < Sheets(sheetName).Cells(b, StandardColumn) Then
Cells(target.Row, currentColumn + 1) = 0
Exit For
End If
If Cells(target.Row, currentColumn) = Sheets(sheetName).Cells(i, StandardColumn) Then '判断是否和评分标准相等
Cells(target.Row, currentColumn + 1) = Sheets(sheetName).Cells(i, 1)
Exit For
Else
If Cells(target.Row, currentColumn) > Sheets(sheetName).Cells(i, StandardColumn) Then
Cells(target.Row, currentColumn + 1) = Sheets(sheetName).Cells(i, 1)
Exit For
End If
End If
End If
End If
Next i
'求和
Call sumScore(target)
End Function
'求和函数
Public Function sumScore(target As Range)
If Cells(target.Row, 5) = "" And Cells(target.Row, 7) = "" And Cells(target.Row, 9) = "" And Cells(target.Row, 11) = "" And Cells(target.Row, 13) = "" And Cells(target.Row, 15) = "" And Cells(target.Row, 17) = "" And Cells(target.Row, 19) = "" And Cells(target.Row, 21) = "" And Cells(target.Row, 23) = "" And Cells(target.Row, 25) = "" And Cells(target.Row, 27) = "" And Cells(target.Row, 29) = "" And Cells(target.Row, 31) = "" And Cells(target.Row, 33) = "" And Cells(target.Row, 35) = "" And Cells(target.Row, 37) = "" And Cells(target.Row, 39) = "" Then
Cells(target.Row, 40) = ""
Else
Cells(target.Row, 40) = Application.WorksheetFunction.Sum(Cells(target.Row, 5), Cells(target.Row, 7), Cells(target.Row, 9), Cells(target.Row, 11), Cells(target.Row, 13), Cells(target.Row, 15), Cells(target.Row, 17), Cells(target.Row, 19), Cells(target.Row, 21), Cells(target.Row, 23), Cells(target.Row, 25), Cells(target.Row, 27), Cells(target.Row, 29), Cells(target.Row, 31), Cells(target.Row, 33), Cells(target.Row, 35), Cells(target.Row, 37), Cells(target.Row, 39))
End If
End Function
在对应的sheet表下写vba程序：
Sub Worksheet_Change(ByVal target As Range)
Dim sheetName As String
sheetName = "U17-18女素质评分标准"
Select Case target.Column
'5.8米x3折返跑（S）
Case 4:
Call autoCalculationASC(target, sheetName, 4, 2, 2, 82)
'全场3/4场加速跑（S）
Case 6:
Call autoCalculationASC(target, sheetName, 6, 3, 2, 82)
'15米x7折返跑（S）
Case 8:
Call autoCalculationASC(target, sheetName, 8, 4, 2, 82)
'俯卧撑（次）
Case 10:
Call autoCalculationDSC(target, sheetName, 10, 5, 2, 82)
'立定跳远（M）
Case 12:
Call autoCalculationDSC(target, sheetName, 12, 6, 2, 82)
'1分钟仰卧起坐（次）
Case 14:
Call autoCalculationDSC(target, sheetName, 14, 7, 2, 82)
'1分钟背起（次）
Case 16:
Call autoCalculationDSC(target, sheetName, 16, 8, 2, 82)
'杠铃高翻
Case 18:
Call autoCalculationDSC(target, sheetName, 18, 9, 2, 82)
'负重半蹲
Case 20:
Call autoCalculationDSC(target, sheetName, 20, 10, 2, 82)
'原地摸高（M）
Case 22:
Call autoCalculationDSC(target, sheetName, 22, 11, 2, 82)
'助跑单脚跳摸高（M）
Case 24:
Call autoCalculationDSC(target, sheetName, 24, 12, 2, 82)
'单跳双停双手摸高（M）
Case 26:
Call autoCalculationDSC(target, sheetName, 26, 13, 2, 82)
'双摇跳绳（次）
Case 28:
Call autoCalculationDSC(target, sheetName, 28, 14, 2, 82)
'髋旋转(次)
Case 30:
Call autoCalculationDSC(target, sheetName, 30, 15, 2, 82)
'肩回环（CM）
Case 32:
Call autoCalculationASC(target, sheetName, 32, 16, 2, 82)
'体前屈（CM）
Case 34:
Call autoCalculationASC(target, sheetName, 34, 17, 2, 82)
'限制区周边多向移动（S）
Case 36:
Call autoCalculationASC(target, sheetName, 36, 18, 2, 82)
'跳起空中转体双手头上传球（M）
Case 38:
Call autoCalculationDSC(target, sheetName, 38, 19, 2, 82)
End Select
End Sub
成绩输入表格如：
这样在前面的一列输入成绩，后面紧跟着的表格就得出了成绩。