UDF: для значений ячеек, меньших x в столбце, вернуть все значения из первого столбца.

Question

Для набора данных, подобного следующему, я хотел бы, если значение в строке 1 равно указанному значению, вернуть все значения столбца идентификатора в строках, где значение ячейки в указанном столбце меньше 3. (Нет повторений значений в столбец идентификатора или в строке 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, независимо от того, какой столбец оценивается. Эта часть должна быть простой, но я не могу понять, как это сделать без смещения, что мне не помогает, потому что оцениваемый столбец будет переменным.

У меня есть простая английская логика, которая мне нужна: "Если значение ячейки в a1:d1 = X, MultiCat a1:a4, где значение ячейки в [выбранный столбец] равно <3". Я могу найти столбец, который я хотел бы выполнить, используя функцию Match, и у меня есть код, который, по моему мнению, должен объединить результаты в одной ячейке.

Я просто не могу понять, как включить результат Match в функцию или как получить функцию для конкатенации столбца ID.

Answer 1

Вы могли бы а) жестко закодировать столбец идентификатора в функцию; б) добавить параметр для передачи столбца идентификатора в функцию; в) передать имя заголовка столбца в функцию.

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 as,

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

Заполните правильно при необходимости.