ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 879|回复: 5

[求助] 数据排序后取值计算

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-3-21 10:02 | 显示全部楼层 |阅读模式
将数据按从大到小的顺序取出,然后再用四舍五入的方法去除后5%的数据,再对这部分数据进行平均分,及格率,优秀率方面的计算,只会用函数,现正在学vba,不知道它的解决思路,请高人指点,谢谢。

工作簿1.rar

14.95 KB, 下载次数: 8

TA的精华主题

TA的得分主题

发表于 2019-3-21 15:39 | 显示全部楼层

  1. Sub VBA统计()
  2.     Dim d As Object, arr(), di(), dk(), Tarr(), arrall()
  3.     Dim i%, j%, b%
  4.     Set d = CreateObject("Scripting.Dictionary")
  5.     arrall = ThisWorkbook.Worksheets(1).Range("A2:B" & Cells(1000000, 1).End(xlUp).Row).Value '将所有成绩数据赋值给数组

  6.     For i = 1 To UBound(arrall) '利用字典统计班级个数,以及各班人数
  7.         d(arrall(i, 1)) = d(arrall(i, 1)) + 1
  8.     Next i
  9.     dk = d.Keys()  '将字典里的班级名称赋值给数组
  10.     di = d.Items()  '将字典里各班人数赋值给数组
  11.    
  12.     ReDim Tarr(1 To d.Count, 1 To 6)
  13.    
  14.     For b = 1 To d.Count   '按班别 循环
  15.         ReDim arr(1 To di(b - 1))
  16.         i = 0
  17.         Do                      '从所有成绩里按班别 取出到数组arr
  18.             i = i + 1
  19.             arr(i) = arrall(i + j, 2)
  20.         Loop Until i = di(b - 1)
  21.         j = j + i
  22.         
  23.         Tarr(b, 1) = dk(b - 1)
  24.         Tarr(b, 2) = di(b - 1)
  25.         Tarr(b, 3) = QuWei(arr)      '计算去5%后人数
  26.         Tarr(b, 4) = RenPing(arr)    '计算人平
  27.         Tarr(b, 5) = JiGeLv(arr)     '计算及格率
  28.         Tarr(b, 6) = YouXiuLv(arr)   '优秀率
  29.     Next b
  30.     ThisWorkbook.Worksheets(1).Range("L2").Resize(d.Count, 6) = Tarr
  31. End Sub
  32. Function QuWei(arr) As Integer '去掉5% ,即去尾
  33.     QuWei = UBound(arr) - Round(UBound(arr) * 0.05, 0)
  34. End Function
  35. Function RenPing(arr) As Double '人平
  36.     Dim SumX#, i%
  37.     For i = Round(UBound(arr) * 0.05, 0) + 1 To UBound(arr)
  38.         SumX = SumX + arr(i)
  39.     Next i
  40.     RenPing = SumX / QuWei(arr)
  41. End Function
  42. Function JiGeLv(arr) As Double '及格率
  43.     Dim SumX%, i%
  44.     For i = Round(UBound(arr) * 0.05, 0) + 1 To UBound(arr)
  45.         If arr(i) >= 60 Then SumX = SumX + 1
  46.     Next i
  47.     JiGeLv = 100 * SumX / QuWei(arr)
  48. End Function
  49. Function YouXiuLv(arr) As Double '优秀率
  50.     Dim SumX%, i%
  51.     For i = Round(UBound(arr) * 0.05, 0) + 1 To UBound(arr)
  52.         If arr(i) >= 80 Then SumX = SumX + 1
  53.     Next i
  54.     YouXiuLv = 100 * SumX / QuWei(arr)
  55. End Function
复制代码

VBA统计1.rar (25.43 KB, 下载次数: 4)

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-3-21 15:44 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

刚才忘记说 也要先排序
主关键词 班级 升序  次关键字 成绩 升序
排序代码可以用录制宏来实现   可以集成到上述代码中

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-3-21 15:52 | 显示全部楼层
autolzg 发表于 2019-3-21 15:44
刚才忘记说 也要先排序
主关键词 班级 升序  次关键字 成绩 升序
排序代码可以用录制宏来实现   可以 ...

也就是说vba不太好实验在数组里排序后再提取,还是要在计算前对表格进行按班级按成绩进行排序后再进行操作是吗?我还以为这些步骤都可以用程序完成,苦于一直找不到思路。谢谢指导。

TA的精华主题

TA的得分主题

发表于 2019-3-21 16:03 | 显示全部楼层
dajiashiren 发表于 2019-3-21 15:52
也就是说vba不太好实验在数组里排序后再提取,还是要在计算前对表格进行按班级按成绩进行排序后再进行操 ...

给数组排序是能实现,但是比较麻烦,说实话现在的我也不会 查查资料也许能学会

数据量非常大时,自己写的排序算法不一定有Excel排序快

Excel的排序功能就挺好用的
可以用录制宏代码给VBA程序 等于是让VBA程序操控Excel排序来排序


TA的精华主题

TA的得分主题

发表于 2019-3-21 20:49 | 显示全部楼层
本帖最后由 网海遨游 于 2019-3-22 08:15 编辑
  1. Sub test()
  2.     [m2:q6].ClearContents '清空需要填写地方数据
  3.     r = [a65536].End(3).Row 'A列有数据最大行号
  4.     Range("a1:b" & r).Sort Cells(1, 1), 1 '对A、B列按A列排序,1是升序,2是降序。
  5.     For i = 1 To 5 '有5个班级,这里要循环5次
  6.         t = Application.CountIf(Range("a:a"), Cells(i + 1, "l")) '统计每个班级人数
  7.         t1 = t - Round(t * 0.05, 0) '去5%后,每班剩下人数
  8.         Cells(i + 1, "m") = t '写入每个班实有人数
  9.         Cells(i + 1, "n") = t1 '写入去5%后,每班剩下人数
  10.         x = t + x '累加人数
  11.         m = 0: n = 0: n1 = 0: n2 = 0 '初始化赋值
  12.         Range("a" & 2 + x - t & ":b" & x + 1).Sort Cells(1, 2), 2 '对每个班级按成绩B列排序
  13.             For Each Rng In Range("b" & 2 + x - t & ":b" & x + 1) '遍历每个班级的成绩
  14.                 n = n + 1 '累加,用于计数
  15.                 m = m + Rng '成绩累加
  16.                     If Rng >= 60 Then n1 = n1 + 1 '统计及格人数
  17.                         If Rng >= 80 Then n2 = n2 + 1 '统计优秀人数
  18.                           If n = t1 Then'当达到需要统计人数时,就……
  19.                             Cells(i + 1, "o") = Round(m / t1, 4) '写入人平分
  20.                             Cells(i + 1, "p") = Round(n1 / t1, 4) * 100 '写入及格率
  21.                             Cells(i + 1, "q") = Round(n2 / t1, 4) * 100 '写入优秀率
  22.                             Exit For '每班达到去5%后,每班剩下人数后退出这层循环
  23.                         End If
  24.             Next Rng
  25.      Next i
  26.      [l1].Select '选择此单元格,让你观察到结果。
  27. End Sub
复制代码

工作簿1.zip

21.69 KB, 下载次数: 3

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 06:34 , Processed in 0.057474 second(s), 13 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表