Question

对于如下所示的数据集，我希望，如果第1行中的值等于指定值，则返回指定列中单元格值小于3的行中的所有ID列值。（ID列或第1行和第34行没有值重复;标题＆＃34;。）

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

例如，如果列标题=＆＃34; X＆＃34;，则返回＆＃34; 123,456和＃34;的值。如果Y，＆＃34; 123,789＆＃34;。如果Z，＆＃34; 789＆＃34;。我发现"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上按原样运行该函数，则返回值＆＃34; 1,2。＆＃34;无论要评估的列如何，结果都必须始终来自ID列。这一部分应该很简单，但我无法弄清楚如何在没有Offset的情况下做到这一点，这对我没有帮助，因为评估的列将是可变的。

我有我需要的简单英语逻辑：＆＃34;如果a1中的单元格值：d1 = X，则MultiCat a1：a4，其中[所选列]中的单元格值<3。＆＃34;我可以找到我想要使用匹配功能进行评估的专栏，我认为我需要在单个单元格中连接结果。

我无法弄清楚如何将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)

根据需要填写。

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

1 个答案: