ExcelVBA成绩统计分析实例集锦.docVIP

成绩分析0705 ‘/viewthread.php?tid=455718pid=2965916page=1extra=page%3D1 ‘如何通过VBA完成成绩分析表0705.xls Public xk$, nj$, fs, r, Arr1, youx(), zgf(), zdf(), rs() Sub cjfx() Dim d, k, t Dim Myr, Arr, Myc, x Set d = CreateObject(Scripting.Dictionary) Application.ScreenUpdating = False Sheet1.Activate Myr = [a65536].End(xlUp).Row Myc = [iv1].End(xlToLeft).Column Arr = Range(Cells(2, 1), Cells(Myr, Myc)) Set r1 = Rows(1).Find(xk) col = r1.Column n = 1: r = 0 For i = 1 To UBound(Arr) If Arr(i, 1) = nj Then x = Arr(i, 1) | Arr(i, 2) If Not d.exists(x) Then d.Add x, Arr(i, 5) r = r + 1 ReDim Preserve rs(1 To r) ReDim Preserve youx(1 To r) ReDim Preserve zgf(1 To r) ReDim Preserve zdf(1 To r) rs(r) = 1 Arr1(r, 1) = nj Arr1(r, 2) = Arr(i, 2) fs = d(x) zgf(r) = fs zdf(r) = fs Call yy Else rs(r) = rs(r) + 1 d(x) = d(x) + Arr(i, 5) fs = Arr(i, 5) Call yy End If End If Next k = d.keys t = d.items 总分 For j = 0 To UBound(k) Arr1(j + 1, 3) = rs(j + 1) Arr1(j + 1, 14) = t(j) / rs(j + 1) 平均分 Arr1(j + 1, 16) = Arr1(j + 1, 15) / rs(j + 1) 及格率 Arr1(j + 1, 17) = youx(j + 1) / rs(j + 1) 优秀率 Arr1(j + 1, 18) = zgf(j + 1) 优秀率 Arr1(j + 1, 19) = zdf(j + 1) 优秀率 Next j End Sub Sub yy() Select Case fs Case 90 To 100 Arr1(r, 4) = Arr1(r, 4) + 1 Case 80 To 89 Arr1(r, 5) = Arr1(r, 5) + 1 Case 70 To 79 Arr1(r, 6) = Arr1(r, 6) + 1 Case 60 To 69 Arr1(r, 7) = Arr1(r, 7) + 1 Case 50 To 59 Arr1(r, 8) = Arr1(r, 8) + 1 Case 40 To 49 Arr1(r, 9) = Arr1(r, 9) + 1 Case 30 To 39 Arr1(r, 10) = Arr1