Excel精英培训网

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

[已解决]从全校成绩册中按班次按名次找出学生姓名

[复制链接]
发表于 2014-4-3 14:04 | 显示全部楼层 |阅读模式
本帖最后由 wkfcoffee 于 2014-4-3 14:26 编辑

分班打印.rar (29.13 KB, 下载次数: 22)
发表于 2014-4-3 14:35 | 显示全部楼层
  1. Sub tt()
  2.     r = Sheet1.[e65536].End(3).Row
  3.     arr = Sheet1.Range("a2:q" & r)
  4.     ReDim brr(1 To UBound(arr), 1 To 14)
  5.     bj = "1101"
  6.     For i = 2 To UBound(arr)     '从数据中取出指定班级
  7.         If arr(i, 4) = bj Then
  8.             k = k + 1
  9.             brr(k, 1) = arr(i, 1)   '序号
  10.             brr(k, 2) = arr(i, 4)   '班号
  11.             brr(k, 3) = arr(i, 7)   '考号
  12.             brr(k, 4) = arr(i, 5)   '姓名
  13.             For j = 5 To 14    '成绩、总分、班名、校名
  14.               brr(k, j) = arr(i, j + 3)
  15.             Next
  16.         End If
  17.     Next
  18.     Dim crr(1 To 14)      '从大到小排序
  19.     For i = 1 To k - 1
  20.         For j = i + 1 To k
  21.             If brr(i, 12) < brr(j, 12) Then
  22.                 For p = 1 To 14
  23.                     crr(p) = brr(i, p)
  24.                     brr(i, p) = brr(j, p)
  25.                     brr(j, p) = crr(p)
  26.                 Next
  27.             End If
  28.         Next
  29.     Next
  30.         
  31.     With Sheet2
  32.         .Range("a3:ac32") = ""
  33.         For i = 1 To k
  34.             c = IIf(i <= 30, 1, 16)
  35.             r = IIf(i <= 30, i + 2, i - 30 + 2)
  36.             .Cells(r, c).Resize(1, 14) = Application.Index(brr, i)
  37.         Next
  38.         .Activate
  39.     End With
  40.    
  41. End Sub
复制代码
回复

使用道具 举报

发表于 2014-4-3 14:43 | 显示全部楼层
请看附件。

分班打印.rar

42.39 KB, 下载次数: 29

回复

使用道具 举报

发表于 2014-4-3 14:58 | 显示全部楼层    本楼为最佳答案   
给你来个全的,所有班级排名表一键生成

分班打印.rar

42.6 KB, 下载次数: 43

回复

使用道具 举报

 楼主| 发表于 2014-4-3 15:29 | 显示全部楼层
grf1973 发表于 2014-4-3 14:58
给你来个全的,所有班级排名表一键生成

太牛了,谢谢!

点评

解决问题评个最佳,下次才有人帮你答题。  发表于 2014-4-6 23:09
回复

使用道具 举报

发表于 2014-4-6 23:06 | 显示全部楼层
学习了
回复

使用道具 举报

 楼主| 发表于 2014-4-10 11:43 | 显示全部楼层
wkfcoffee 发表于 2014-4-3 15:29
太牛了,谢谢!

谢谢!
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-28 16:44 , Processed in 0.688947 second(s), 12 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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