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

Question

对于如下所示的数据集，如果第1行中的值等于指定值，则返回所有ID列行值，其中指定列中的单元格的值小于3（无重复的值的ID列或行1“报头”。）

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

例如，如果列标题=“X” ，返回值为“123,456”。如果Y，“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其中单元格值[所选列]为< 3.”我可以找到我想要使用Match函数执行评估的列，并且我认为我需要将代码连接到单个单元格中的代码。

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

Answer 1

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

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

填权必要G5为，：

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。