用EXCEL中的VBA进行复杂的数据统计(3)

用EXCEL中的VBA进行复杂的数据统计

件，设置数据源区域：设置!$B$3:!$B$12，单元格链接：设置!$B$2，这样能够方便地选择需要统计的科目。选定A2单元格，输入公式="东莞市”&YEAR(NOW())&"年高考"&INDEX(设置!B3:B12,设置!B2)&"科成绩统计表"，其中函数YEAR（）与NOW（）可得到当年的年份，而函数INDEX(设置!B3:B12,设置!B2)则可以动态地得到下拉框所选中的科目名称。

3、选定“设置”的C2单元格，输入公式=INDEX(C3:C12,B2)，获得选中科目的列标。 4、在“各科统计表”中，增加“统计结果”命令按钮，使用VBA编制以下程序：

Private Sub CommandButton1_Click()

Dim n1, n2, n3, n4, np, nt As Integer '四批的入围人数、上线人数和考生总数

Dim score_pass, score_total, score_top As Integer '上线考生总分、全体考生总分、最高分 grade1 = Sheets("设置").Range("E3"): grade2 = Sheets("设置").Range("E4") '各批分数线 grade3 = Sheets("设置").Range("E5"): grade4 = Sheets("设置").Range("E6") col_subject = Sheets("设置").Range("C2") '统计科目列号 school = Sheets("成绩总表").Range("C3") '第一个学校校名 j = 5 '各科统计表起始行

n1 = 0: n2 = 0: n3 = 0: n4 = 0: np = 0: nt = 0 score_pass = 0: score_total = 0: score_top = 0 ' ActiveSheet.Range("A5:O50") = "" '清空 With ActiveSheet

For i = 3 To Sheets(3).UsedRange.Rows.Count + 1 '源数据行范围 If Sheets("成绩总表").Range("C" & CStr(i)) = school Then

score = Sheets("成绩总表").Range(col_subject & CStr(i)) '读成绩 If score >= grade1 Then n1 = n1 + 1

If score >= grade2 And score < grade1 Then n2 = n2 + 1 If score >= grade3 And score < grade2 Then n3 = n3 + 1 If score >= grade4 And score < grade3 Then n4 = n4 + 1

If score >= grade4 Then score_pass = score_pass + score: np = np + 1 If score > 0 Then score_total = score_total + score: nt = nt + 1 If score > score_top Then score_top = score Else

.Range("A" & CStr(j)) = school: .Range("B" & CStr(j)) = nt '校名、报考人数 If nt > 0 Then

.Range("C" & CStr(j)) = n1: .Range("D" & CStr(j)) = n1 * 100 / nt '第一批人数、比例 .Range("E" & CStr(j)) = n2: .Range("F" & CStr(j)) = n2 * 100 / nt '第二批人数、比例 .Range("G" & CStr(j)) = n3: .Range("H" & CStr(j)) = n3 * 100 / nt '第三批人数、比例 .Range("I" & CStr(j)) = n4: .Range("J" & CStr(j)) = n4 * 100 / nt '第四批人数、比例 .Range("K" & CStr(j)) = np: .Range("L" & CStr(j)) = np * 100 / nt '上线总人数、比例 If np > 0 Then .Range("M" & CStr(j)) = score_pass / np '上线考生平均分

.Range("N" & CStr(j)) = score_top: .Range("O" & CStr(j)) = score_total / nt '最高分、总平均分 End If

school = Sheets("成绩总表").Range("C" & CStr(i)) j = j + 1: i = i - 1

n1 = 0: n2 = 0: n3 = 0: n4 = 0: np = 0: nt = 0 score_pass = 0: score_total = 0: score_top = 0 End If Next i End With

MsgBox "数据统计已经完成！", vbInformation, "提示信息…"