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

对于如下所示的数据集，如果第1行中的值等于指定值，则返回指定列中的单元格值小于3的行中的所有ID列值。（没有值重复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”。 我发现了一个“多元公式” （编辑链接的答案）的变体，这个变体接近于满足我的需求，但是我无法适应它。

  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列，而不pipe被评估的列是什么。 这部分应该是简单的，但我不知道如何做到这一点没有偏移，这不会帮助我，因为评估列将是可变的。

我需要简单的英文逻辑：“如果a1中的单元格的值：d1 = X，则MultiCat a1：a4中[所选列中的单元格值] <3。 我可以find我想要使用Match函数进行评估的列，并且我认为我需要在单个单元格中连接结果。

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

Answer 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) 

根据需要填写。