Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2685|回复: 5

[已解决]请各位版主和老师看看用什么程序可以实现成绩统计

[复制链接]
发表于 2014-11-16 18:32 | 显示全部楼层 |阅读模式
1、当成绩在输入表中全部输入完毕后,求宏的程序输入表中的数据直接导入全年级表中指定位置(从第4行开始)。2、在全年级表中各单科的年名和总分我是用函数做的,而在表中的所有班名用什么方法做我就不知道了,请各位版主和老师看看用什么程序可以实现。我想实现的是:先将输入表中数值的导入到全年级表。导入后先进行求和、总分排序、总分的班名、年名排序、最后再做各个单科的年名和班名。问题可能有些难度,请各位版主和老师多多费心了,在此我先表示感谢了!!!具体见附件。(请您编写的宏程序只对应这2个表,我还有其他表,希望不会影响其他表)

最佳答案
2014-11-17 14:00
请看附件。

统计程序.zip

35.92 KB, 下载次数: 20

发表于 2014-11-17 13:59 | 显示全部楼层
  1. Sub tt()
  2.     brr = Sheets("输入表").[a1].CurrentRegion
  3.     ReDim arr(1 To UBound(brr), 1 To 32)
  4.     For i = 3 To UBound(brr)
  5.         For j = 1 To 4           '导入前4列数据
  6.             arr(i - 2, j) = brr(i, j)
  7.         Next
  8.         For j = 5 To UBound(brr, 2)        '导入各科成绩
  9.             arr(i - 2, (j - 5) * 3 + 5) = Val(brr(i, j))
  10.             arr(i - 2, 32) = arr(i - 2, 32) + Val(brr(i, j))
  11.         Next
  12.     Next
  13.     Range("a4").Resize(UBound(arr), UBound(arr, 2)) = arr
  14.    
  15.     Set d = CreateObject("scripting.dictionary")
  16.     arr = Range("a1:ai" & [c65536].End(3).Row): r = UBound(arr)
  17.     For j = 5 To 32 Step 3           'j对应成绩列
  18.         Set xrng = Cells(4, j).Resize(r - 3, 1)         'j列(用于计算年级排名)
  19.         If Application.WorksheetFunction.Sum(xrng) > 0 Then         'j列非空
  20.             For i = 4 To UBound(arr)
  21.                 bj = arr(i, 3): fs = Val(arr(i, j))          '班级,分数
  22.                 arr(i, j + 2) = Application.WorksheetFunction.Rank(fs, xrng)       '年级排名
  23.                 If Not d.exists(bj) Then Set d(bj) = Cells(i, j) Else Set d(bj) = Union(d(bj), Cells(i, j))        '把相同班级单元格存入字典,用于计算班级排名
  24.             Next
  25.             For i = 4 To UBound(arr)
  26.                 bj = arr(i, 3): fs = arr(i, j)
  27.                 arr(i, j + 1) = Application.WorksheetFunction.Rank(fs, d(bj))     '班级排名
  28.                 If j = 32 Then arr(i, j + 3) = arr(i, j + 1) - arr(i, j + 2)       '最后一列“进步”(按原公式)
  29.             Next
  30.         d.RemoveAll
  31.         End If
  32.     Next
  33.     Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr
  34. End Sub
复制代码
回复

使用道具 举报

发表于 2014-11-17 14:00 | 显示全部楼层    本楼为最佳答案   
请看附件。

统计程序.rar

43.29 KB, 下载次数: 31

回复

使用道具 举报

 楼主| 发表于 2014-11-17 22:19 | 显示全部楼层
grf1973 发表于 2014-11-17 14:00
请看附件。

感谢您的帮助,您编写的程序正是我想要的。现想求一个自动筛选的程序。现求一个通过全年级表中数据先进行班级的筛选,将筛选结果分别进入不同的班级。例如:现在1班、2班表中所有的数据都是我先通过筛选,再进行复制粘贴而得来的。我班最多为50人,在第54行后我要加其他函数进行计算。具体见附件,谢谢!!!

求自动筛选程序.zip

47.24 KB, 下载次数: 8

回复

使用道具 举报

发表于 2014-11-18 13:26 | 显示全部楼层
搞定。。。。。。

求自动筛选程序.rar

34.53 KB, 下载次数: 11

回复

使用道具 举报

发表于 2014-11-19 09:20 | 显示全部楼层
grf1973 发表于 2014-11-18 13:26
搞定。。。。。。

{:1112:}
回复

使用道具 举报

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

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-28 21:56 , Processed in 0.367352 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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