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

Question

对于如下数据集，我想，如果第1行的值等于指定值，return指定列中的单元格值为的行中的所有ID列值小于 3。（ID 列或第 1 行中没有值重复 "headers"。）

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

例如，如果列 header = "X"，return 值为“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 上的函数，它 return 的值为“1、2”。结果需要始终来自 ID 列，而不考虑正在评估的列。那部分应该很简单，但我无法弄清楚如果没有 Offset 怎么办，这对我没有帮助，因为评估的列将是可变的。

我有我需要的简单英语逻辑："If value of cell in a1:d1 = X, MultiCat a1:a4 where cell value in [selected column] is <3."我可以找到我想使用 Match 函数执行评估的列，并且我有我认为需要连接结果的代码在一个单元格中。

我只是想不出如何将 Match 的结果合并到函数中，或者如何获得连接 ID 列的函数。

Answer 1

您可以 a) hard-code 将 ID 列放入函数中； b) 添加一个参数以将 ID 列传递给函数； c) 将列 header 名称传递给函数。

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：对于列中小于 x 的单元格值，return 第一列中的所有值

UDF: For cell values less than x in a column, return all values from first column

excel

vba

udf