UDF：对于列中小于 x 的单元格值，返回第一列中的所有值

Posted 2023-04-13

【中文标题】UDF：对于列中小于 x 的单元格值，返回第一列中的所有值

【英文标题】：UDF: For cell values less than x in a column, return all values from first column

【发布时间】：2016-08-17 03:33:32

【问题描述】：

对于像下面这样的数据集，我想，如果第1行的值等于指定的值，则返回指定列中单元格值小于3的行中的所有ID列值。（否值在 ID 列或第 1 行“标题”中重复。）

ID  | X | Y | Z    
123 | 1 | 2 | 5    
456 | 2 | 6 | 4    
789 | 6 | 1 | 2  

例如，如果列标题 = "X"，则返回值 "123, 456"。如果是，“123, 789”。如果 Z，“789”。我发现 "multicat formula" 的变体（在链接答案的编辑中）可以满足我的需求，但我无法适应它。

  Public Function MultiCat2( _
    ByRef rRng As Excel.Range, _
    Optional ByVal sDelim As String = "") _
         As String
 Dim rCell As Range
 For Each rCell In rRng
    If rCell.Value < 3 Then
     MultiCat2 = MultiCat2 & sDelim & rCell.Text
     End If
 Next rCell
 MultiCat2 = Mid(MultiCat2, Len(sDelim) + 1)  
 End Function

例如，如果我在 X 上按原样运行该函数，它会返回一个值“1, 2”。结果需要始终来自 ID 列，而不管正在评估的列。那部分应该很简单，但是如果没有 Offset，我无法弄清楚如何做到这一点，这对我没有帮助，因为评估的列将是可变的。

我有我需要的简单的英语逻辑：“如果 a1:d1 中的单元格值 = X，MultiCat a1:a4 其中 [选定列] 中的单元格值

我只是不知道如何将 Match 的结果合并到函数中，或者如何让函数连接 ID 列。

【参考方案1】：

您可以 a) 将 ID 列硬编码到函数中； b) 添加一个参数，将 ID 列传递给函数； c) 将列标题名称传递给函数。

Option Explicit

Public Function MultiCat2A(ByRef rRng As Excel.Range, _
                           Optional ByVal sDelim As String = ",") _
                         As String
    Dim c As Long, cRng As Range

    'restrict rRng to the .UsedRange
    Set rRng = Intersect(rRng, rRng.Parent.UsedRange)
    'set cRng to another column but equal to rRng
    Set cRng = Intersect(rRng.EntireRow, rRng.Parent.Columns("A"))

    For c = 1 To rRng.Count
       If rRng(c).Value < 3 Then
        MultiCat2A = MultiCat2A & sDelim & cRng(c).Text
        End If
    Next c

    MultiCat2A = Mid(MultiCat2A, Len(sDelim) + 1)
    If CBool(Len(sDelim)) Then
        Do While Right(MultiCat2A, Len(sDelim)) = sDelim
            MultiCat2A = Left(MultiCat2A, Len(MultiCat2A) - Len(sDelim))
        Loop
    End If
End Function

Public Function MultiCat2B(ByRef cRng As Range, _
                           ByRef rRng As Excel.Range, _
                           Optional ByVal sDelim As String = ",") _
                         As String
    Dim c As Long

    'restrict rRng to the .UsedRange
    Set rRng = Intersect(rRng, rRng.Parent.UsedRange)
    'resize cRng to the same as rRng
    Set cRng = cRng(1, 1).Resize(rRng.Rows.Count, rRng.Columns.Count)

    For c = 1 To rRng.Count
       If rRng(c).Value < 3 Then
        MultiCat2B = MultiCat2B & sDelim & cRng(c).Text
        End If
    Next c

    MultiCat2B = Mid(MultiCat2B, Len(sDelim) + 1)
    If CBool(Len(sDelim)) Then
        Do While Right(MultiCat2B, Len(sDelim)) = sDelim
            MultiCat2B = Left(MultiCat2B, Len(MultiCat2B) - Len(sDelim))
        Loop
    End If
End Function

Public Function MultiCat2C(ByVal sHdr As String, _
                           ByRef rRng As Excel.Range, _
                           Optional ByVal sDelim As String = ",") _
                         As String
    Dim c As Long, cRng As Range

    'restrict rRng to the .UsedRange
    Set rRng = Intersect(rRng, rRng.Parent.UsedRange)
    'find the column by header label
    c = Application.Match(sHdr, rRng.Parent.Rows(1), 0)
    'offset cRng by its column vs rRng's column
    Set cRng = rRng(1, 1).Offset(0, c - rRng.Column)

    For c = 1 To rRng.Count
       If rRng(c).Value < 3 Then
        MultiCat2C = MultiCat2C & sDelim & cRng(c).Text
        End If
    Next c

    MultiCat2C = Mid(MultiCat2C, Len(sDelim) + 1)
    If CBool(Len(sDelim)) Then
        Do While Right(MultiCat2C, Len(sDelim)) = sDelim
            MultiCat2C = Left(MultiCat2C, Len(MultiCat2C) - Len(sDelim))
        Loop
    End If
End Function

在示例图像的 G2:G5 中，

=MultiCat2A(B2:B4)
=MultiCat2B($A2:$A4, B2:B4)
=MultiCat2C("ID", B2:B4)
=MultiCat2C($A1, B2:B99)

根据需要填写。

【讨论】：

顺便说一句，我相信传递给 UDF 函数的所有参数都是ByVal，无论您声明它们是什么；我必须做一些 google-fu 来确认这一点。