|
|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
本帖最后由 WYS67 于 2019-1-7 14:24 编辑
各位老师：EXCEL的排名函数面对多个相同的数值时，无法妥善处理名次排位的问题。本附件试图从历史数据【即前几行】的顺延中，寻求接近渐变趋势的排位规则，只是这种方法，用EXCEL现有的自带函数不大容易解决。恳请论坛里的高手大神们，根据附件里的排名规则，编写个计算结果准确，运算速度高效快捷自定义函数。
按数值从大到小返回前一二三名对应序号的自定义函数.zip
(13.59 KB, 下载次数: 18)
曾经有位老师，写了如下代码，计算结果正确，但数据源区域必须是三列才适用，多一列少一列都不行！无法适用于数据源为6列，9列的情况。恳请老师们看看怎样使代码能够在大于三列的前提下全部适用。
Function CSPW(rng As Range, Optional rn = "")
Application.Volatile
Dim ar, br, dr, cr, er, p, pp, q, qq, i, j, k, r, s, t, m, n, x
ar = rng: ReDim p(1 To 3), q(1 To 3)
ReDim br(1 To UBound(ar), 0), cr(1 To UBound(ar), 0)
ReDim er(1 To UBound(ar), 0), dr(1 To UBound(ar), 0)
For k = UBound(ar) To 1 Step -1
If ar(k, 1) <> "" Then Exit For
br(k, 0) = "": cr(k, 0) = "": dr(k, 0) = "": er(k, 0) = ""
Next
For i = 1 To k
m = Application.Max(ar(i, 1), ar(i, 2), ar(i, 3)): s = 0
n = Application.Min(ar(i, 1), ar(i, 2), ar(i, 3)): t = 0
For j = 1 To 3
If ar(i, j) = m Then s = s + 1: p(s) = j - 1
If ar(i, j) = n Then t = t + 1: q(t) = j - 1
Next
If s = 3 Then
If i = 1 Then
br(i, 0) = 0: cr(i, 0) = 1: dr(i, 0) = 2
Else
br(i, 0) = br(i - 1, 0): cr(i, 0) = cr(i - 1, 0): dr(i, 0) = dr(i - 1, 0)
End If
End If
If s = 1 And t = 1 Then br(i, 0) = p(1): cr(i, 0) = 3 - p(1) - q(1): dr(i, 0) = q(1)
If s = 2 Then
If i = 1 Then
br(i, 0) = p(1): cr(i, 0) = p(2): dr(i, 0) = 3 - p(1) - p(2)
Else
r = br(i - 1, 0) & cr(i - 1, 0) & dr(i - 1, 0)
pp = InStr(r, p(1)) & InStr(r, p(2))
If Mid(pp, 1, 1) <= Mid(pp, 2, 1) Then
br(i, 0) = p(1): cr(i, 0) = p(2): dr(i, 0) = 3 - p(1) - p(2)
Else
br(i, 0) = p(2): cr(i, 0) = p(1): dr(i, 0) = 3 - p(1) - p(2)
End If
End If
End If
If t = 2 Then
If i = 1 Then
br(i, 0) = 3 - q(1) - q(2): cr(i, 0) = q(1): dr(i, 0) = q(2)
Else
r = br(i - 1, 0) & cr(i - 1, 0) & dr(i - 1, 0)
qq = InStr(r, q(1)) & InStr(r, q(2))
If Mid(qq, 1, 1) <= Mid(qq, 2, 1) Then
br(i, 0) = 3 - q(1) - q(2): cr(i, 0) = q(1): dr(i, 0) = q(2)
Else
br(i, 0) = 3 - q(1) - q(2): cr(i, 0) = q(2): dr(i, 0) = q(1)
End If
End If
End If
If ar(i, 1) = "" Then br(i, 0) = ""
If ar(i, 2) = "" Then cr(i, 0) = ""
If ar(i, 3) = "" Then dr(i, 0) = ""
er(i, 0) = br(i, 0) & cr(i, 0) & dr(i, 0)
Next
If rn = "" Then CSPW = er
If rn = 1 Then CSPW = br
If rn = 0 Then CSPW = cr
If rn = -1 Then CSPW = dr
End Function
按出现次数多少排名.zip
(222.73 KB, 下载次数: 5)
补充内容 (2019-7-18 17:48):
最新问题附件在 35楼里 |
|
/1 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2019-1-6 10:32
楼主