Excel交流网
  • 设为首页|收藏本站|手机版
  • Excel-教程-技巧-培训视频

  • 网站首页
  • Excel教程
  • 关于我们
  • 新闻动态
  • Excel资源
  • 招贤纳士

Excel教程

Excel操作
Excel函数
Excel图表
Excel VBA
Excel 行业应用

联系方式

Excel中国 联系方式
电  话:400-855-3990
邮  编:528400
Email:support@zstm.com
网  址:www.excel-cn.com

当前位置:网站首页 > Excel教程 > Excel VBA
Excel VBA

EXCEL VBA轻松处理超难排名问题

我们大家可能经常用EXCEL来制作排名表吧,用rank函数还是比较简单的。

但是如果你看下面的情况,会显示相当麻烦


摘自:办公小助手(头条号)


数据源:

发大招!EXCEL让人崩溃的超难排名问题!VBA轻松搞定!

要求:依据F列的成绩,分别进行全市,全省,全国排名!

那我们该如何解决呢?


建个宏,代码如下:

Sub 排名()

Dim r&, i&

Dim arr

tt = Timer

Dim d1 As Object, d2 As Object, d3 As Object

Set d1 = CreateObject("scripting.dictionary")

Set d2 = CreateObject("scripting.dictionary")

Set d3 = CreateObject("scripting.dictionary")

With Worksheets("Sheet1")

r = .Cells(.Rows.Count, 1).End(xlUp).Row

.Range("g4:i" & r).ClearContents

arr = .Range("a4:i" & r)

For i = 1 To UBound(arr)

If Len(arr(i, 6)) <> 0 Then

d1(arr(i, 6)) = d1(arr(i, 6)) + 1

If Not d2.exists(arr(i, 5)) Then

Set d2(arr(i, 5)) = CreateObject("scripting.dictionary")

End If

d2(arr(i, 5))(arr(i, 6)) = d2(arr(i, 5))(arr(i, 6)) + 1

If Not d3.exists(arr(i, 5)) Then

Set d3(arr(i, 5)) = CreateObject("scripting.dictionary")

End If

If Not d3(arr(i, 5)).exists(arr(i, 4)) Then

Set d3(arr(i, 5))(arr(i, 4)) = CreateObject("scripting.dictionary")

End If

d3(arr(i, 5))(arr(i, 4))(arr(i, 6)) = d3(arr(i, 5))(arr(i, 4))(arr(i, 6)) + 1

End If

Next

KK = d1.keys

nn = 1

For k = 0 To UBound(KK)

mm = Application.Large(KK, k + 1)

ss = d1(mm)

d1(mm) = nn

nn = nn + ss

Next

For Each aa In d2.keys

KK = d2(aa).keys

nn = 1

For k = 0 To UBound(KK)

mm = Application.Large(KK, k + 1)

ss = d2(aa)(mm)

d2(aa)(mm) = nn

nn = nn + ss

Next

Next

For Each aa In d3.keys

For Each bb In d3(aa).keys

KK = d3(aa)(bb).keys

nn = 1

For k = 0 To UBound(KK)

mm = Application.Large(KK, k + 1)

ss = d3(aa)(bb)(mm)

d3(aa)(bb)(mm) = nn

nn = nn + ss

Next

Next

Next

For i = 1 To UBound(arr)

If Len(arr(i, 6)) <> 0 Then

arr(i, 9) = d1(arr(i, 6))

arr(i, 8) = d2(arr(i, 5))(arr(i, 6))

arr(i, 7) = d3(arr(i, 5))(arr(i, 4))(arr(i, 6))

End If

Next

.Range("a4").Resize(UBound(arr), UBound(arr, 2)) = arr

End With

End Sub

然后运行宏即可!!!效果如下图所示,厉害吧。


发大招!EXCEL让人崩溃的超难排名问题!VBA轻松搞定!

这里要说下,本工作表表名要是Sheet1,如果不是,你可以要让第七排的代码“With Worksheets("Sheet1")”修改为自己的表名;还有要保证成绩在F这一栏哦。该代码适用范围比较广,比如也可用于班级年级排名等,只要保证E列为大类,F列为小类均可使用。

朋友们,怎么样简单吧,感觉复制代码,去试试看噻。


点击次数:  更新时间:2017-02-27 16:42:08  【打印此页】  【关闭】
上一条:自动生成随机姓名  下一条:提取相同字符串且统计最大相同数
本站动态|在线留言|在线反馈|友情链接|会员中心|站内搜索|网站地图|网站管理

中山市天鸣科技发展有限公司 版权所有 1999-2020 粤ICP备10043721号

广东省中山市西苑广场富贵阁 528400

QQ:4008553990 电话:0760-88315075

Excel交流网主要交流Excel教程、Excel技巧、Excel培训、Excel函数公式、Excel图表以及Excel VBA,为网友提供一个最全的Excel交流网站

Excel教程|Excel技巧|Excel培训|Excel函数公式|Excel图表|VBA

Powered by MetInfo 5.3.12 ©2008-2022  www.metinfo.cn