Excel VBA 统分

最新推荐文章于 2024-05-28 15:38:59 发布

转载最新推荐文章于 2024-05-28 15:38:59 发布 · 199 阅读

CC 4.0 BY-SA版权

原文链接：http://www.cnblogs.com/XH16/p/6514748.html

“查看排名”按钮代码：

 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