|
- Sub VBA统计()
- Dim d As Object, arr(), di(), dk(), Tarr(), arrall()
- Dim i%, j%, b%
- Set d = CreateObject("Scripting.Dictionary")
- arrall = ThisWorkbook.Worksheets(1).Range("A2:B" & Cells(1000000, 1).End(xlUp).Row).Value '将所有成绩数据赋值给数组
- For i = 1 To UBound(arrall) '利用字典统计班级个数,以及各班人数
- d(arrall(i, 1)) = d(arrall(i, 1)) + 1
- Next i
- dk = d.Keys() '将字典里的班级名称赋值给数组
- di = d.Items() '将字典里各班人数赋值给数组
-
- ReDim Tarr(1 To d.Count, 1 To 6)
-
- For b = 1 To d.Count '按班别 循环
- ReDim arr(1 To di(b - 1))
- i = 0
- Do '从所有成绩里按班别 取出到数组arr
- i = i + 1
- arr(i) = arrall(i + j, 2)
- Loop Until i = di(b - 1)
- j = j + i
-
- Tarr(b, 1) = dk(b - 1)
- Tarr(b, 2) = di(b - 1)
- Tarr(b, 3) = QuWei(arr) '计算去5%后人数
- Tarr(b, 4) = RenPing(arr) '计算人平
- Tarr(b, 5) = JiGeLv(arr) '计算及格率
- Tarr(b, 6) = YouXiuLv(arr) '优秀率
- Next b
- ThisWorkbook.Worksheets(1).Range("L2").Resize(d.Count, 6) = Tarr
- End Sub
- Function QuWei(arr) As Integer '去掉5% ,即去尾
- QuWei = UBound(arr) - Round(UBound(arr) * 0.05, 0)
- End Function
- Function RenPing(arr) As Double '人平
- Dim SumX#, i%
- For i = Round(UBound(arr) * 0.05, 0) + 1 To UBound(arr)
- SumX = SumX + arr(i)
- Next i
- RenPing = SumX / QuWei(arr)
- End Function
- Function JiGeLv(arr) As Double '及格率
- Dim SumX%, i%
- For i = Round(UBound(arr) * 0.05, 0) + 1 To UBound(arr)
- If arr(i) >= 60 Then SumX = SumX + 1
- Next i
- JiGeLv = 100 * SumX / QuWei(arr)
- End Function
- Function YouXiuLv(arr) As Double '优秀率
- Dim SumX%, i%
- For i = Round(UBound(arr) * 0.05, 0) + 1 To UBound(arr)
- If arr(i) >= 80 Then SumX = SumX + 1
- Next i
- YouXiuLv = 100 * SumX / QuWei(arr)
- End Function
复制代码
VBA统计1.rar
(25.43 KB, 下载次数: 4)
|
评分
-
1
查看全部评分
-
|