按数值从大到小返回前一二三名对应序号的自定义函数

WYS67

恳请老师们帮忙扩展原代码数据列数或重新编写新代码！

WYS67

lsdongjh 发表于 2019-1-9 09:23

经测试验证，和模拟结果完全一样！谢谢老师！

WYS67

lsdongjh 发表于 2019-1-9 09:23

老师：您写的代码完全实现了我想要的统计功能【见下面左图】！
      但是，仅仅只能在数据源刚好是九列的情况下，才能进行前三排位统计，多一列少一列都不行，却又极大地限制了这个代码广阔的使用前途，并且当A4:F4的序号名称发生变化时【就假设如A4:F4的两位数，或者是英文简称，又或者是职工姓名】，不知还能不能返回正确的结果？

     所以，怎样才不局限于当前的九列数据，修改为：当数据源在3~9列时还仍然适用？让公式根据数据区域的列数，返回前三序号名称【不仅仅限于0~8的一位数数字】，如此即可大大提高代码的适用范围和统计功能，真正成为一个万金油的排名函数！

WYS67

lsdongjh 发表于 2019-1-9 09:23

恳请老师们帮忙完善代码，使之能够对3~9列的数据都能进行前三排位。

WYS67

恳请老师们帮忙完善代码，使之能够对3~9列的数据都能进行前三排位

WYS67

lsdongjh 发表于 2019-1-9 09:23

恳请老师们帮忙完善代码，使之能够对3~9列的数据都能进行前三的名称进行排位。

lsdongjh

1. Option Explicit
   
2. 
   
3. Function QSPW(rgData As Range, Optional arrIndex As Variant = 4) As Variant
   
4.     Dim arrTitle As Variant, arrData As Variant, rgCur As Range
   
5.     Dim lngRow As Long, lngCol As Long, lngCols As Long, intLen As Integer
   
6.     Dim lngVal() As Long, strVal() As String
   
7.     Dim arrResult As Variant, arrReturn As Variant, lngID As Long
   
8.     Dim lngIndex As Long, strTemp(1 To 3) As String, strAll As String
   
9.    
   
10.     Application.Volatile True
    
11.    
    
12.     lngCols = rgData.Columns.Count
    
13.     If lngCols < 3 Then Exit Function '小于3列退出
    
14.    
    
15.     ReDim lngVal(1 To lngCols) As Long, strVal(1 To lngCols) As String
    
16.    
    
17.     arrTitle = rgData.Offset(-1, 0).Resize(1) '标题区域是数据区域的上一行
    
18.     arrData = rgData
    
19.     lngID = arrIndex
    
20.    
    
21.     Set rgCur = Application.Caller
    
22.     ReDim arrResult(1 To rgCur.Rows.Count, 1 To 4) As String
    
23.     Set rgCur = Nothing
    
24.    
    
25.     For lngRow = LBound(arrData) To UBound(arrData)
    
26.         If arrData(lngRow, 1) = "" Then Exit For
    
27.         For lngCol = 1 To lngCols
    
28.             strVal(lngCol) = arrData(lngRow, lngCol) & strVal(lngCol)
    
29.             lngVal(lngCol) = Val(Trim(Mid(strVal(lngCol), 1, 7)) & Format(lngCol, "00"))
    
30.         Next
    
31.         
    
32.         lngIndex = lngIndex + 1: strAll = ""
    
33.         For lngCol = 1 To 3
    
34.             strTemp(lngCol) = Right(CStr(Application.WorksheetFunction.Large(lngVal, lngCol)), 2)
    
35.             strAll = strAll & arrTitle(1, strTemp(lngCol))
    
36.             arrResult(lngIndex, lngCol) = arrTitle(1, strTemp(lngCol))
    
37.         Next
    
38.         arrResult(lngIndex, 4) = strAll
    
39.     Next
    
40.    
    
41.     arrReturn = Application.WorksheetFunction.Index(arrResult, 0, lngID)
    
42.     QSPW = arrReturn
    
43. End Function
    

复制代码

WYS67

lsdongjh 发表于 2019-1-10 12:23

老师：您这次写的代码太好了！完完全全实现了我的初衷！万分感激老师的热心帮忙！

WYS67

lsdongjh 发表于 2019-1-10 12:23

老师：请看上面左边的截图：A:C列数据源各个单元格里的数字都<=9，所以H:K列的计算结果正确；而N:P列数据源各个单元格里的数字部分>=9【两位数】，所以R:U列的计算结果大部分不正确！我又测试了上面右边截图里数据源为7列，里面的数字在0~1000时的计算结果，发现大部分也存在错误。

恳请老师修改代码：让需要统计的数据源里的数字突破位数限制，对>9的多位数【理论上不限位数】数字仍然能够排名。

数据源数字超过9【一位数】时结果就会出错？.zip (27.11 KB, 下载次数: 6)

2019-1-10 18:19 上传

点击文件名下载附件

WYS67

恳请老师们帮忙，解决32楼描述的问题。