无论是学校的老师,还是做销售管理,还是做财务,经常要做同一个工作:制作排行榜
很多人都是手工排序,然后手工添加名次:
麻烦在于名次要一个个的输入,因为有分数相同的,如果向下拖动复制容易出错。用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精英培训。
500册财务书籍免费送~
《财务成本管理与内部控制实用全书》
全面覆盖企业财务管理

由浅入深系统分析讲解

提高会计工作效率
……
扫码下方二维码,参加活动免费领取
👇👇👇
CMA报名开始
 高顿为所有考生量身打造一份学习计划 

通过循序渐进的课程学习
全程个性化的辅导
帮助零基础考生在较短周期内顺利通过CMA考试
点击
阅读原文
,查看更多开班信息!
继续阅读
阅读原文