乒乓球等级分计算程序11b

乒乓球等级分计算程序 1.1b版 3/22/2012 Dim iPlayerNum As Integer '选手数量' Dim iGameNum As Integer '已进行比赛次数' Dim iGameChang As Integer '已经进行的比赛的场数' Dim iFenShuCha '比赛双方加减分' Dim djf(5000, 2) As Integer '等级分，最多处理五千名选手，' '第一列为前一次比赛的等级分，供计算分差用，第二列为统计本次比赛等级分用' Dim i, j, k, m, n, found As Integer Dim result As String Public Sub tongjixuanshougeshu() '统计选手个数' For i = 2 To 32767 Step 1 If (Sheets(1).Cells.Item(i, 2) = "") Then GoTo over11 Else Sheets(1).Cells.Item(i, 1) = i - 1 '序号' End If Next i over11: iPlayerNum = i - 2 '选手个数' Sheets(1).Cells.Item(i, 1) = "合计" + CStr(iPlayerNum) '显示选手个数' End Sub Public Sub xuanshoumingchongfuxingjiancha() '选手重复性检查' result = "" For i = 2 To iPlayerNum Step 1 '从第二行开始 For j = i + 1 To iPlayerNum + 1 Step 1 If (Sheets(1).Cells.Item(j, 2) = Sheets(1).Cells.Item(i, 2)) Then result = result + "第 " + CStr(i - 1) + " 和第" + CStr(j - 1) + "重复，" End If Next j Next i If (result <> "") Then MsgBox (result) Open "c:\选手名重复.txt" For Output As #1 Write #1, result Close #1 CommandButton3.Enabled = False End If '检查选手名有没有重复的，并提示,有重复，则不能进行下一步' End Sub Public Sub tishitianxiechushifen() '提示用户填写选手初始等级分' For i = 1 To iPlayerNum Step 1 If (Sheets(1).Cells.Item(i + 1, 8) = "") Then MsgBox ("请填写选手的初始等级分！！！") CommandButton3.Enabled = False GoTo over11 End If Next i over11: i = i End Sub Public Sub tongjibisaichangshu() '统计比赛场数，是全部比赛场数' '统计比赛场数' For i = 2 To 32767 Step 1 If (Sheets(2).Cells.Item(i, 2) = "") Then GoTo over12 Else Sheets(2).Cells.Item(i, 1) = i - 1 '序号' End If Next i over12: iGameChang = i - 2 '比赛场数' Sheets(2).Cells.Item(i, 1) = "合计" + CStr(iGameChang) + "场比赛" '提示比赛场数' End Sub Public Sub jianchayouwuxinxuanshou() '检查有无新选手，有，则result不为空' result = "" For i = 1 To iGameChang Step 1 '比赛场数' found = 0 For j = 1 To iPlayerNum Step 1 '选手数量' If (Sheets(2).Cells.Item(i + 1, 2) = Sheets(1).Cells.Item(j + 1, 2)) Then found = 1 End If Next j If (found = 0) Then result = result + "第" + CStr(i) + "场胜方选手" + _ CStr(Sheets(2).Cells.Item(i + 1, 2)) + "不在名单中。" End If found = 0 For j = 1 To iPlayerNum Step 1 '选手数量' If (Sheets(2).Cells.Item(i + 1, 3) = Sheets(1).Cells.Item(j + 1, 2)) Then found = 1 End If Next j If (found = 0) Then result = result + "第" + CStr(i) _ + "场负方选手" + CStr(Sheets(2).Cells.Item(i + 1, 3)) + "不在名单中。" End If Next i If (result <> "") Then Open "c:\有新选手.txt" For Output As #1 Write #1, result Close #1 End If End Sub Public Sub jianchabisaichongfushuru() '检查比赛重复输入' '找到第一场未统计的比赛的序号' For i = 1 To iGameChang Step 1 If (Sheets(2).Cells.Item(i + 1, 4) <> "是") Then GoTo over13 End If Next i over13: result = "" '检查未统计比赛是否有重复输入的情况' For j = i To iGameChang - 1 Step 1 For k = j + 1 To iGameChang Step 1 If (Sheets(2).Cells.Item(j + 1, 2) = Sheets(2).Cells.Item(k + 1, 2) _ And Sheets(2).Cells.Item(j + 1, 3) = Sheets(2).Cells.Item(k + 1, 3)) Then result = result + "第" + CStr(j) + "场比赛与第" + CStr(k) + "场比赛重复！ " End If Next k Next j If (result <> "") Then MsgBox (result) CommandButton2.Enabled = False '有错，比赛重复输入，不能进行补齐赛前等级分' Open "c:\比赛重复输入.txt" For Output As #1 Write #1, result Close #1 End If End Sub Public Sub buqisaiqiandengjifen() '补齐赛前等级分' '取得已经进行的比赛次数' For i = 1 To 32760 Step 1 If (Sheets(1).Cells.Item(1, i) = "") Then iGameNum = i - 9 '已进行了的比赛次数，次数等于第一行第一个空单元格的列号减9' GoTo out2 '得到已经进行了的比赛次数，最新一次比赛还未统计' End If Next i out2: MsgBox ("已经比赛次数为：" + CStr(iGameNum)) For i = 1 To iPlayerNum Step 1 For j = 9 To iGameNum + 7 If (Sheets(1).Cells.Item(i + 1, j) = "") Then Sheets(1).Cells.Item(i + 1, j) = Sheets(1).Cells.Item(i + 1, j - 1) End If Next j Next i MsgBox ("已经补齐" + CStr(i - 1) + "个选手的赛前积分") End Sub Public Sub jisuandengjifen() '计算等级分' Call tongjixuanshougeshu '统计选手个数' Call tongjibisaichangshu '统计比赛场数' '找到第一场未统计的比赛的序号' For i = 1 To iGameChang Step 1 If (Sheets(2).Cells.Item(i + 1, 4) <> "是") Then GoTo over43 End If Next i over43: result = "" 'i为第一场未统计的比赛的序号 ' If (i > iGameChang) Then MsgBox ("没有未统计比赛场次，本次统计退出！") GoTo over46 End If '取得赛前等级分，存放到数组djf 中,两列都一样，列号为0,1 ' For j = 1 To iPlayerNum Step 1 djf(j, 0) = CInt(Sheets(1).Cells.Item(j + 1, iGameNum + 7)) '行号比序号多1，j为序号 ' djf(j, 1) = djf(j, 0) Next j For j = i To iGameChang Step 1 '一共有iGameChang-i+1 场比赛需要统计，j为当前处理的场的序号 ' For k = 1 To iPlayerNum Step 1 '找胜方选手的序号，存放在变量k中 ' If (Sheets(2).Cells.Item(j + 1, 2) = Sheets(1).Cells.Item(k + 1, 2)) Then GoTo over44 Next k over44: result = "" For m = 1 To iPlayerNum Step 1 '找负方选手的序号，存放在变量m中' If (Sheets(2).Cells.Item(j + 1, 3) = Sheets(1).Cells.Item(m + 1, 2)) Then GoTo over45 Next m over45: result = "" '下面开始计算等级分' n = djf(k, 0) - djf(m, 0) '胜方等级分减去负方等级分，存放在变量n中' If (n <= -238) Then iFenShuCha = 50 '负数 表 关于同志近三年现实表现材料材料类招标技术评分表图表与交易pdf视力表打印pdf用图表说话 pdf 示低分方取胜' If (n <= -213 And n >= -237) Then iFenShuCha = 45 '负数表示低分方取胜' If (n <= -188 And n >= -212) Then iFenShuCha = 40 '负数表示低分方取胜' If (n <= -163 And n >= -187) Then iFenShuCha = 35 '负数表示低分方取胜' If (n <= -138 And n >= -162) Then iFenShuCha = 30 '负数表示低分方取胜' If (n <= -113 And n >= -137) Then iFenShuCha = 25 '负数表示低分方取胜' If (n <= -88 And n >= -112) Then iFenShuCha = 20 '负数表示低分方取胜' If (n <= -63 And n >= -87) Then iFenShuCha = 16 '负数表示低分方取胜' If (n <= -38 And n >= -62) Then iFenShuCha = 13 '负数表示低分方取胜' If (n <= -13 And n >= -37) Then iFenShuCha = 10 '负数表示低分方取胜' If (n <= 0 And n >= -12) Then iFenShuCha = 8 '负数表示低分方取胜' If (n >= 0 And n <= 12) Then iFenShuCha = 8 '正数表示高分方取胜' If (n >= 13 And n <= 37) Then iFenShuCha = 7 '正数表示高分方取胜' If (n >= 38 And n <= 62) Then iFenShuCha = 6 '正数表示高分方取胜' If (n >= 63 And n <= 87) Then iFenShuCha = 5 '正数表示高分方取胜' If (n >= 88 And n <= 112) Then iFenShuCha = 4 '正数表示高分方取胜' If (n >= 113 And n <= 137) Then iFenShuCha = 3 '正数表示高分方取胜' If (n >= 138 And n <= 162) Then iFenShuCha = 2 '正数表示高分方取胜' If (n >= 163 And n <= 187) Then iFenShuCha = 2 '正数表示高分方取胜' If (n >= 188 And n <= 212) Then iFenShuCha = 1 '正数表示高分方取胜' If (n >= 213 And n <= 237) Then iFenShuCha = 1 '正数表示高分方取胜' If (n >= 238) Then iFenShuCha = 0 '正数表示高分方取胜' djf(k, 1) = djf(k, 1) + iFenShuCha '胜方加分' djf(m, 1) = djf(m, 1) - iFenShuCha '负方减分' Sheets(2).Cells.Item(j + 1, 4) = "是" '做出本场（j）比赛已统计标志' Next j '将计算后的结果存回表格' For j = 1 To iPlayerNum Step 1 'j为选手序号' Sheets(1).Cells.Item(j + 1, iGameNum + 8) = djf(j, 1) '行号比序号多1，j为序号 ' Next j over46: result = "" End Sub Public Sub tongji() Dim start1, end1 As Integer Dim cs(5000) As Integer '次数，用于参赛次数和比赛场数的计算统计' Dim qs(5000) As Integer '取胜比赛的场数' Dim aGameDate, tempstring As String '比赛日期' For i = 0 To 4999 Step 1 cs(i) = 0 qs(i) = 0 Next i '先清零' start1 = 2 '第一次比赛的日期起始行号为2' For i = 1 To iGameNum Step 1 '总共有iGameNum次比赛，看你参加了几次，根据第二个表格的比赛日期判断' aGameDate = CStr(Sheets(2).Cells.Item(start1, 5)) For end1 = start1 To 30000 Step 1 '找到本次比赛成绩统计结束行号' tempstring = CStr(Sheets(2).Cells.Item(end1, 5)) If (tempstring <> aGameDate) Then GoTo out51 End If Next end1 out51: end1 = end1 - 1 For j = 1 To iPlayerNum Step 1 '一次比赛一共要统计这么多选手' For k = start1 To end1 Step 1 If (Sheets(2).Cells.Item(k, 2) = Sheets(1).Cells.Item(j + 1, 2) _ Or Sheets(2).Cells.Item(k, 3) = Sheets(1).Cells.Item(j + 1, 2)) Then cs(j) = cs(j) + 1 GoTo out52 '下一个选手' End If Next k out52: cs(j) = cs(j) Next j start1 = end1 + 1 '统计下一次比赛，这些选手是不是参赛了' Next i '全部比赛都统计完了，现在开始把数据送回第一个表格的第3列' For i = 1 To iPlayerNum Step 1 Sheets(1).Cells.Item(i + 1, 3) = CStr(cs(i)) Next i '下面统计每个选手参加比赛的场数,以及取胜的场数' For i = 1 To iPlayerNum Step 1 cs(i) = 0 '先清零' qs(i) = 0 Next i For j = 1 To iPlayerNum Step 1 '一次比赛一共要统计这么多选手，选手序号为j ' For k = 1 To iGameChang Step 1 If (Sheets(2).Cells.Item(k + 1, 2) = Sheets(1).Cells.Item(j + 1, 2) _ Or Sheets(2).Cells.Item(k + 1, 3) = Sheets(1).Cells.Item(j + 1, 2)) Then cs(j) = cs(j) + 1 End If If (Sheets(2).Cells.Item(k + 1, 2) = Sheets(1).Cells.Item(j + 1, 2)) Then qs(j) = qs(j) + 1 '取胜场数加1' End If Next k out53: cs(j) = cs(j) Next j For i = 1 To iPlayerNum Step 1 Sheets(1).Cells.Item(i + 1, 4) = cs(i) '将比赛场数送回第一个表格' Sheets(1).Cells.Item(i + 1, 5) = qs(i) '将取胜场数送回第一个表格' Next i '下面开始计算等级分排名' For i = 1 To iPlayerNum Step 1 cs(i) = 1 '假定是第一名，有人比自己高，自己就降低一名，并列算最好的名次' For j = 1 To iPlayerNum Step 1 If (Sheets(1).Cells.Item(i + 1, iGameNum + 8) < Sheets(1).Cells.Item(j + 1, iGameNum + 8)) Then cs(i) = cs(i) + 1 End If Next j Sheets(1).Cells.Item(i + 1, 6) = cs(i) '第六列为等级分排名' Next i End Sub Private Sub CommandButton1_Click() '选手名检查' Call tongjixuanshougeshu '统计选手个数' CommandButton3.Enabled = True '假定可以进行下一步，如果有错，则在子过程中禁止进行' Call xuanshoumingchongfuxingjiancha '检查选手名重复性，并在子过程提示,有重复，则不能进行下一步' Call tishitianxiechushifen '提示用户填写选手初始等级分,如果有没填写的，则不能进行下一步' CommandButton1.Enabled = False '不允许重复检查选手名' End Sub Private Sub CommandButton3_Click() '第二步：检查有无新选手，以及比赛是否重复输入' Call tongjixuanshougeshu '统计选手个数' Call tongjibisaichangshu '统计比赛场数' CommandButton2.Enabled = True '假定能顺利通过检查，则可以补齐赛前等级分' Call jianchayouwuxinxuanshou '检查有无新选手' If (result <> "") Then '如果有新选手，则在这里过程中提示用户，并退出程序' MsgBox (result) CommandButton2.Enabled = False '不允许补齐赛前等级分' GoTo over31 End If Call jianchabisaichongfushuru '检查比赛是否重复输入，在过程中提示用户' If (result <> "") Then '如果有比赛重复输入，则在子过程中提示用户，' CommandButton2.Enabled = False '不允许补齐赛前等级分' GoTo over31 End If over31: CommandButton3.Enabled = False '不允许重复检查新选手' End Sub Private Sub CommandButton2_Click() '第三步：补齐赛前等级分' Call buqisaiqiandengjifen '补齐赛前等级分' CommandButton4.Enabled = True '允许计算等级分' CommandButton2.Enabled = False '不允许重复补齐' End Sub Private Sub CommandButton4_Click() '第四步：计算本日比赛之后的等级分' Call jisuandengjifen '调用计算等级分过程' CommandButton5.Enabled = True '允许进行比赛次数计算' CommandButton4.Enabled = False '不允许重复计算程序' End Sub Private Sub CommandButton5_Click() '第五步：统计选手参赛次数、比赛场数' Call tongji '调用统计过程' CommandButton5.Enabled = False '不允许重复计算' End Sub