Excel VBA 统分
“查看排名”按钮代码：
1 Private Sub CommandButton1_Click() 2 3 Dim cq(1000) '保存抽签序号 4 Dim bj(1000) '保存参赛班级 5 Dim gq(1000) '保存参赛项目 6 Dim df(1000) '保存最终得分 7 Dim c, b, g, d '临时变量 8 Dim num '存放参数对象数量 9 10 '获取A3-后面的非空行数 11 num = Application.WorksheetFunction.CountA(Sheets("统分").Range("A3:A1002")) 12 'MsgBox num 13 14 '获取抽签序号、班级、项目和得分 15 For i = 1 To num 16 cq(i) = Sheet3.Cells(i + 3, 1) 17 bj(i) = Sheet3.Cells(i + 3, 2) 18 gq(i) = Sheet3.Cells(i + 3, 3) 19 If Sheet3.Cells(i + 3, 27) = "" Then 20 df(i) = 0 21 Else 22 df(i) = Sheet3.Cells(i + 3, 27) 23 End If 24 Next i 25 26 '按照得分按大到小排序 27 For i = 1 To num - 1 28 For j = i + 1 To num 29 If df(i) <= df(j) Then 30 31 d = df(i) '交换最终得分 32 df(i) = df(j) 33 df(j) = d 34 35 c = cq(i) '交换抽签序号 36 cq(i) = cq(j) 37 cq(j) = c 38 39 b = bj(i) '交换参赛班级 40 bj(i) = bj(j) 41 bj(j) = b 42 43 g = gq(i) '交换参赛项目 44 gq(i) = gq(j) 45 gq(j) = g 46 47 End If 48 Next j 49 Next i 50 51 '将抽签序号、班级、项目和得分填入工作表4 52 For i = 1 To num 53 Sheet4.Cells(i + 2, 1) = cq(i) 54 Sheet4.Cells(i + 2, 2) = bj(i) 55 Sheet4.Cells(i + 2, 3) = gq(i) 56 Sheet4.Cells(i + 2, 4) = df(i) 57 Next i 58 59 '按照得分排名（中国式） 60 Sheet4.Cells(3, 5) = 1 '第1个班级 61 For i = 2 To num '第2-num班级 62 If Sheet4.Cells(i + 2, 4) = Sheet4.Cells(i + 1, 4) Then 63 Sheet4.Cells(i + 2, 5) = Sheet4.Cells(i + 1, 5) 64 Else 65 Sheet4.Cells(i + 2, 5) = Sheet4.Cells(i + 1, 5) + 1 66 End If 67 Next i 68 69 For i = 1 To num 70 If Sheet4.Cells(i + 2, 4) = 0 Then 71 Sheet4.Cells(i + 2, 1) = "" 72 Sheet4.Cells(i + 2, 2) = "" 73 Sheet4.Cells(i + 2, 3) = "" 74 Sheet4.Cells(i + 2, 4) = "" 75 Sheet4.Cells(i + 2, 5) = "" 76 End If 77 Next i 78 Sheets("结果").Select 79 80 End Sub
“清空数据”代码：
1 Private Sub CommandButton2_Click() 2 3 Dim flag 4 flag = MsgBox("请问您确认要清空表数据吗？", 1) 5 If flag = 1 Then 6 7 Dim num1, num2 '存放参数对象数量 8 9 '统分表数据清空 10 '获取A3-后面的非空行数 11 num1 = Application.WorksheetFunction.CountA(Sheets("统分").Range("A4:A1003")) 12 'MsgBox num 13 14 '清空抽签序号到最后一个评委共23列num行数据 15 For i = 1 To num1 16 For j = 1 To 23 17 Sheet3.Cells(i + 3, j) = "" 18 Next j 19 Next i 20 21 '结果表数据清空 22 '获取A3-后面的非空行数 23 num2 = Application.WorksheetFunction.CountA(Sheets("结果").Range("A3:A1002")) 24 25 '清空抽签序号到排名共5列num行数据 26 For i = 1 To num2 27 For j = 1 To 5 28 Sheet4.Cells(i + 2, j) = "" 29 Next j 30 Next i 31 Else 32 MsgBox "您已取消清空表中数据~！" 33 End If 34 End Sub
“按序号显示”结果：
1 Private Sub CommandButton2_Click() 2 3 Dim cq(1000) '保存抽签序号 4 Dim bj(1000) '保存参赛班级 5 Dim gq(1000) '保存参赛项目 6 Dim df(1000) '保存最终得分 7 Dim pm(1000) '排名 8 Dim c, b, g, d '临时变量 9 10 Dim num '存放参数对象数量 11 12 '获取A列 A3-后面的非空行数 13 num = Application.WorksheetFunction.CountA(Sheets("结果").Range("A3:A1000")) 14 'MsgBox num 15 16 '获取抽签序号、班级、项目和得分 17 For i = 1 To num 18 cq(i) = Sheet4.Cells(i + 2, 1) 19 bj(i) = Sheet4.Cells(i + 2, 2) 20 gq(i) = Sheet4.Cells(i + 2, 3) 21 df(i) = Sheet4.Cells(i + 2, 4) 22 pm(i) = Sheet4.Cells(i + 2, 5) 23 24 Next i 25 26 '按照抽签小到大排序 27 For i = 1 To num - 1 28 For j = i + 1 To num 29 If cq(i) >= cq(j) Then 30 31 c = cq(i) '交换抽签序号 32 cq(i) = cq(j) 33 cq(j) = c 34 35 b = bj(i) '交换参赛班级 36 bj(i) = bj(j) 37 bj(j) = b 38 39 g = gq(i) '交换参赛项目 40 gq(i) = gq(j) 41 gq(j) = g 42 43 d = df(i) '交换最终得分 44 df(i) = df(j) 45 df(j) = d 46 47 p = pm(i) '交换排名 48 pm(i) = pm(j) 49 pm(j) = p 50 51 End If 52 Next j 53 Next i 54 55 '将抽签序号、班级、项目和得分填入工作表4 56 For i = 1 To num 57 Sheet4.Cells(i + 2, 1) = cq(i) 58 Sheet4.Cells(i + 2, 2) = bj(i) 59 Sheet4.Cells(i + 2, 3) = gq(i) 60 Sheet4.Cells(i + 2, 4) = df(i) 61 Sheet4.Cells(i + 2, 5) = pm(i) 62 Next i 63 64 65 Range("A3").Select 66 End Sub
“按排名显示”结果：
1 Private Sub CommandButton3_Click() 2 3 Dim cq(1000) '保存抽签序号 4 Dim bj(1000) '保存参赛班级 5 Dim gq(1000) '保存参赛项目 6 Dim df(1000) '保存最终得分 7 Dim pm(1000) '排名 8 Dim c, b, g, d '临时变量 9 10 Dim num '存放参数对象数量 11 12 '获取A列 A3-后面的非空行数 13 num = Application.WorksheetFunction.CountA(Sheets("结果").Range("A3:A1000")) 14 'MsgBox num 15 16 '获取抽签序号、班级、项目和得分 17 For i = 1 To num 18 cq(i) = Sheet4.Cells(i + 2, 1) 19 bj(i) = Sheet4.Cells(i + 2, 2) 20 gq(i) = Sheet4.Cells(i + 2, 3) 21 df(i) = Sheet4.Cells(i + 2, 4) 22 pm(i) = Sheet4.Cells(i + 2, 5) 23 24 Next i 25 26 '按照名次小到大排序 27 For i = 1 To num - 1 28 For j = i + 1 To num 29 If pm(i) >= pm(j) Then 30 31 c = cq(i) '交换抽签序号 32 cq(i) = cq(j) 33 cq(j) = c 34 35 b = bj(i) '交换参赛班级 36 bj(i) = bj(j) 37 bj(j) = b 38 39 g = gq(i) '交换参赛项目 40 gq(i) = gq(j) 41 gq(j) = g 42 43 d = df(i) '交换最终得分 44 df(i) = df(j) 45 df(j) = d 46 47 p = pm(i) '交换排名 48 pm(i) = pm(j) 49 pm(j) = p 50 51 End If 52 Next j 53 Next i 54 55 '将抽签序号、班级、项目和得分填入工作表4 56 For i = 1 To num 57 Sheet4.Cells(i + 2, 1) = cq(i) 58 Sheet4.Cells(i + 2, 2) = bj(i) 59 Sheet4.Cells(i + 2, 3) = gq(i) 60 Sheet4.Cells(i + 2, 4) = df(i) 61 Sheet4.Cells(i + 2, 5) = pm(i) 62 Next i 63 64 65 Range("A3").Select 66 End Sub