无论是学校的老师,还是从做销售管理,经常要做同一个工作:制作排行榜
很多人都是手工排序,然后手工添加名次:
麻烦在于名次要一个个的输入,因为有分数相同的,如果向下拖动复制容易出错。用rank函数也无法处理相同分数的问题。
除了语文,还有数学、化学等排名榜都需要你手工制作。下次数据更新后,还要手工操作一遍。
是不是很麻烦?是!
为了解决排行榜难题,兰色编了一个自定义函数,可以实现自动生成排行榜。无论数据怎么变,排名榜都可以自动更新。
下面,只需要1分钟,你也可以生成自动更新的排名榜。
操作步骤 :
1、复制下面代码
'示例用代码
Function PaiMing(rg As Range, rg1 As Range)
Dim iOuter As Long
Dim iInner As Long
Dim iLBound As Long
Dim iUBound As Long
Dim iTemp As Double
Dim x As Long, k As Long
Dim arr1, arr2, arr3(1 To 10000, 1 To 3)
arr1 = rg
arr2 = rg1
If UBound(arr1, 2) > 1 Then
arr1 = Application.Transpose(arr1)
arr2 = Application.Transpose(arr2)
End If
iLBound = LBound(arr1)
iUBound = UBound(arr1)
'冒泡排序
For iOuter = iLBound To iUBound
For iInner = iLBound To iUBound - iOuter
'比较相邻项
If arr1(iInner, 1) < arr1(iInner + 1, 1) Then
'交换值
iTemp = arr1(iInner, 1)
iTemp1 = arr2(iInner, 1)
arr1(iInner, 1) = arr1(iInner + 1, 1)
arr1(iInner + 1, 1) = iTemp
arr2(iInner, 1) = arr2(iInner + 1, 1)
arr2(iInner + 1, 1) = iTemp1
End If
Next iInner
Next iOuter
For x = 1 To UBound(arr1)
arr3(x, 1) = arr2(x, 1)
arr3(x, 2) = arr1(x, 1)
k = k + 1
If x > 1 Then
If arr1(x, 1) = arr1(x - 1, 1) Then k = k - 1
End If
arr3(x, 3) = k
Next x
PaiMing = arr3
End Function
2、粘贴代码
工作表标签右键 - 查看代码 - 在新打开的VBE窗口插入模块 - 把代码粘贴到右侧的窗口中,然后关闭窗口。
3、保存文件
当前文件另存为“Excel 启用宏的工作簿”
设置完成后,就可以使用排名函数了。
1、用法介绍
=PaiMing(数据区域,对应排名指标)
语法说明:
数据区域:要排名的数据区域,可以是一列区域,也可以是一行区域。
对应排名指标:和数据一一对应的指标。
2、设置方法
以生成语文排名为例,选取i3:k8区域(根据排行榜需要选取行数),在编辑栏中输入公式
=PaiMing(B2:B15,A2:A15)
然后按Ctrl+Shift+Enter三键完成输入(输入后公式两边会添加大括号{})
生成排行也可以用一般的函数公式,太复杂。也可以用数据透视表,但每次都要刷新。用今天兰色写的paiming函数一劳永逸,以后也可不用操心排行榜了。哦, 因为wps默认不支持Vba,想用还要安装VBA插件了。
来源:Excel精英培训,作者:赵志东