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

WYS67

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

前三排名.zip (706.37 KB, 下载次数: 4)

2019-7-19 06:17 上传

点击文件名下载附件

老师：由于我拙嘴笨舌，叙述的不清楚，给您造成了误会，真是对不起！

    38楼附件存在的问题是:当I586:K586【最后数据行】以下没有数据时，应该屏蔽S587:U587以下为空白才对；【I5:K1468】

     如上面左图所示的问题--数据源I5:K589列的数据区域里，其中有18行没有数据；而数据区域的最后行号是I589:K589，用了40楼的代码后，从数据区域第一个空行对应的M44以下都显示成了空白。

     我需要的是：只让数据区域【I5:K1468】的最后数据行【I589:K589】对应的M589以下显示空白，而M44:M589仍须按运算规则显示结果。


   老师可根据附件O5:O45的原代码，进行修改。附原代码：

Function Q3PM(rgData As Range, Optional arrIndex As Variant = 4) As Variant
    Dim arrTitle As Variant, arrData As Variant, rgCur As Range
    Dim lngRow As Long, lngCol As Long, lngCols As Long, intLen As Integer
    Dim lngVal() As Long, strVal() As String
    Dim arrResult As Variant, arrReturn As Variant, lngID As Long
    Dim lngIndex As Long, strTemp(1 To 3) As String, strAll As String

    Application.Volatile True

    lngCols = rgData.Columns.Count
    If lngCols < 3 Then Exit Function '小于3列退出

    ReDim lngVal(1 To lngCols) As Long, strVal(1 To lngCols) As String

    arrTitle = rgData.Offset(-1, 0).Resize(1) '标题区域是数据区域的上一行
    arrData = rgData
    lngID = arrIndex

    Set rgCur = Application.Caller
    ReDim arrResult(1 To rgCur.Rows.Count, 1 To 4) As String
    Set rgCur = Nothing

    For lngRow = LBound(arrData) To UBound(arrData)
        If arrData(lngRow, 1) = "" Then Exit For
        For lngCol = 1 To lngCols
            strVal(lngCol) = Format(arrData(lngRow, lngCol), "00") & strVal(lngCol)
            lngVal(lngCol) = Val(Trim(Mid(strVal(lngCol), 1, 6)) & Format(lngCol, "00"))
        Next

        lngIndex = lngIndex + 1: strAll = ""
        For lngCol = 1 To 3
            strTemp(lngCol) = Right(CStr(Application.WorksheetFunction.Large(lngVal, lngCol)), 2)
            strAll = strAll & arrTitle(1, strTemp(lngCol))
            arrResult(lngIndex, lngCol) = arrTitle(1, strTemp(lngCol))
        Next
        arrResult(lngIndex, 4) = strAll
    Next

    arrReturn = Application.WorksheetFunction.Index(arrResult, 0, lngID)
    Q3PM = arrReturn
End Function

WYS67

恳请老师帮忙解决44楼反映的问题。

lsdongjh

问题有多方面，修改了另外一个函数，确保不会有多余的0返回，然后，再修改本次的函数，找到有内容的最后一行，详见附件
前三排名.rar (685.89 KB, 下载次数: 7)

2019-7-19 12:03 上传

点击文件名下载附件

WYS67

lsdongjh 发表于 2019-7-19 12:03
问题有多方面，修改了另外一个函数，确保不会有多余的0返回，然后，再修改本次的函数，找到有内容的最后一 ...

前三排名.zip (708.83 KB, 下载次数: 3)

2019-7-19 12:42 上传

点击文件名下载附件

首先，万分感谢老师的帮忙！  如截图所示，发现M列有许多结果没有按照原来的运算规则进行计算，N列里新增加的数据才是M列本行应该显示的正确结果。我需要的是：只让数据区域【I5:K1468】的最后数据行【I589:K589】对应的--M589以下显示空白，而M5:M589仍须按原运算规则显示计算结果。

  如果修改实在困难，那我就还按照原有的代码进行计算【如38楼截图所示，虽然S587:T587运行多了不必要的数据，但是S5:T586之间显示的计算结果倒是正确！】


再次感谢老师的热心帮忙！

lsdongjh

不支持负数！！！组合不了

WYS67

lsdongjh 发表于 2019-7-19 13:33
不支持负数！！！组合不了

老师，您这一提醒让我恍然大悟--现在回想起来，您写的XHCOUNTIF和Q3PM函数，原先一直都能显示正确结果，就是在这个有负数存在的附件里才第一次出现了错误。

我可以修改《总表》AN列的公式，避免计算结果出现负数。

再次感谢您的提醒！

WYS67

lsdongjh 发表于 2019-7-19 12:03
问题有多方面，修改了另外一个函数，确保不会有多余的0返回，然后，再修改本次的函数，找到有内容的最后一 ...

前三排名.zip (672.12 KB, 下载次数: 11)

2019-7-23 19:07 上传

点击文件名下载附件

老师：请看截图--同样的代码，上图没有加载宏，由于数据源I615:R615以下没有数据，所以S615以下显示正确的空白；而加载宏后的下图，尽管数据源I615:R615以下没有数据,但S615:S936仍然显示数字，而没有显示空白！

辅助列V列是I:R列每一行的数字和，自V615以下为0，我把W列的公式加了个判断条件，选定W5:W1468，输入区域数组公式 {  =IF(SUM(V5:V1468)=0,"",Q3PM($I$5:$R$1468,1))   ，这样无论有没有加载宏，W列都能显示正确的结果【也就是由于I615:R615以下数据和为0，所以W615以下显示空白】！

老师：能不能这样--在代码里增加一个判断条件，当数据区域的任意一行和值为0时，强制使Q3PM对应行的计算结果为空白？如此，则可彻底解决数据源I615:R615以下没有数据,但S615:S936仍然显示数字的问题！

如果此方法可行，您看加在下面代码的哪个地方合适？

Function Q3PM(rgData As Range, Optional arrIndex As Variant = 4) As Variant
    Dim arrTitle As Variant, arrData As Variant, rgCur As Range
    Dim lngRow As Long, lngCol As Long, lngCols As Long, intLen As Integer
    Dim lngVal() As Long, strVal() As String, strALL As String
    Dim arrResult As Variant, arrReturn As Variant, lngID As Long
    Dim lngIndex As Long, strTemp(1 To 3) As String, strIsNull As String

    Application.Volatile True

    lngCols = rgData.Columns.Count
    If lngCols < 3 Then Exit Function '小于3列退出

    ReDim lngVal(1 To lngCols) As Long, strVal(1 To lngCols) As String

    arrTitle = rgData.Offset(-1, 0).Resize(1) '标题区域是数据区域的上一行
    arrData = rgData
    lngID = arrIndex

    Set rgCur = Application.Caller
    ReDim arrResult(1 To rgCur.Rows.Count, 1 To 4) As String
    Set rgCur = Nothing

    For lngRow = LBound(arrData) To UBound(arrData)
        If arrData(lngRow, 1) = "" Then Exit For
        strIsNull = ""
        For lngCol = 1 To lngCols
            strIsNull = strIsNull & arrData(lngRow, lngCol)
            strVal(lngCol) = Format(arrData(lngRow, lngCol), "00") & strVal(lngCol)
            lngVal(lngCol) = Val(Trim(Mid(strVal(lngCol), 1, 6)) & Format(lngCol, "00"))
        Next
        If Val(strIsNull) = 0 Then Exit For
        lngIndex = lngIndex + 1: strALL = ""
        For lngCol = 1 To 3
            strTemp(lngCol) = Right(CStr(Application.WorksheetFunction.Large(lngVal, lngCol)), 2)
            strALL = strALL & arrTitle(1, strTemp(lngCol))
            arrResult(lngIndex, lngCol) = arrTitle(1, strTemp(lngCol))
        Next
        arrResult(lngIndex, 4) = strALL
    Next

    arrReturn = Application.WorksheetFunction.Index(arrResult, 0, lngID)
    Q3PM = arrReturn
End Function

WYS67

也就是在代码中判断条件：当数据源I:R的任意一行全部为空或全部为0时，结果输出列的对应行显示为空白！

WYS67

请在50楼原代码中合适的地方，添加一句判断---当数据源I:R列的任意一行全部为空或全部为0时，结果输出列的对应行显示为空白！

WYS67

请在50楼原代码中合适的地方，添加一句判断---当数据源I:R列的任意一行全部为空或全部为0时，结果输出列的对应行显示为空白！