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

WYS67

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

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

WYS67

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

WYS67

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

WYS67

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

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

WYS67

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

前三排名.zip (697.98 KB, 下载次数: 9)

2019-7-18 13:34 上传

点击文件名下载附件

老师：S:U列是用您27楼代码，对数据源I5:R1468的计算结果。

由于数据源I587:R1468的每行都没有一个数据存在，所以S587:U1468理应全部显示空白才对；

想不明白为什么 S587:U936为何显示9，8，7，而S937:U1468才显示空白？

恳请老师看看是怎么回事，并在27楼代码的合适地方，增加代码：当数据源整行没有数据时，相应的结果输出列也必须显示为空白！
如本附件中，数据源最后行是I586:R586,那么S587:U587以下都应该显示为空白才对！

WYS67

恳请老师解决38楼反映的问题。

lsdongjh

1. Function Q3PM(rgData As Range, Optional arrIndex As Variant = 4) As Variant
   
2.     Dim arrTitle As Variant, arrData As Variant, rgCur As Range
   
3.     Dim lngRow As Long, lngCol As Long, lngCols As Long, intLen As Integer
   
4.     Dim lngVal() As Long, strVal() As String, strALL As String
   
5.     Dim arrResult As Variant, arrReturn As Variant, lngID As Long
   
6.     Dim lngIndex As Long, strTemp(1 To 3) As String, strIsNull As String
   
7.    
   
8.     Application.Volatile True
   
9.    
   
10.     lngCols = rgData.Columns.Count
    
11.     If lngCols < 3 Then Exit Function '小于3列退出
    
12.    
    
13.     ReDim lngVal(1 To lngCols) As Long, strVal(1 To lngCols) As String
    
14.    
    
15.     arrTitle = rgData.Offset(-1, 0).Resize(1) '标题区域是数据区域的上一行
    
16.     arrData = rgData
    
17.     lngID = arrIndex
    
18.    
    
19.     Set rgCur = Application.Caller
    
20.     ReDim arrResult(1 To rgCur.Rows.Count, 1 To 4) As String
    
21.     Set rgCur = Nothing
    
22.    
    
23.     For lngRow = LBound(arrData) To UBound(arrData)
    
24.         If arrData(lngRow, 1) = "" Then Exit For
    
25.         strIsNull = ""
    
26.         For lngCol = 1 To lngCols
    
27.             strIsNull = strIsNull & arrData(lngRow, lngCol)
    
28.             strVal(lngCol) = Format(arrData(lngRow, lngCol), "00") & strVal(lngCol)
    
29.             lngVal(lngCol) = Val(Trim(Mid(strVal(lngCol), 1, 6)) & Format(lngCol, "00"))
    
30.         Next
    
31.         If Val(strIsNull) = 0 Then Exit For
    
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.     Q3PM = arrReturn
    
43. End Function
    

复制代码

WYS67

对不起说错了，最新问题附件在 38楼里

WYS67

lsdongjh 发表于 2019-7-18 18:02

经反复测试，这次写的代码非常完美地解决了问题！谢谢老师！

WYS67

lsdongjh 发表于 2019-7-18 18:02