Проблема с UDF, предназначенным для объединения нескольких совпадений в vlookup - PullRequest
0 голосов
/ 09 января 2019

Для жизни я не могу понять, почему это не работает. Это дает мне ошибку # ЗНАЧЕНИЕ.

Я использую ActiveSheet, потому что я положу его на несколько разных листов, и мне не нужно добавлять поле в функцию для этого.

LookupRange предназначен для поиска последней строки с данными в ней на ActiveSheet.

Мои значения поиска начинаются с B5 и продолжаются бесконечно, а желаемые совпадения находятся в столбце O (15-й столбец).

Function EmailConcat(LookupValue As String)

Application.Volatile

Dim i As Long
Dim Result As String
Dim LookupSheet As Worksheet
Dim LookupRange As Range

Set LookupSheet = Application.ActiveSheet

LookupRange = LookupSheet.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row

For i = 5 To LookupRange.Rows.Count
    If LookupSheet.Cells(i, 2) = LookupValue Then

    Result = Result & LookupSheet.Cells(i, 15) & "; "

    End If
Next i

EmailConcat = Left(Result, Len(Result) - 2)

End Function

Ответы [ 2 ]

0 голосов
/ 09 января 2019

Использование ThisCell для обеспечения точности результатов и чтение столбца поиска в массив для повышения производительности:

Function EmailConcat(LookupValue As String)

    Application.Volatile

    Dim vals, rv, i As Long, sep As String

    If LookupValue <> "" Then
        With Application.ThisCell.Worksheet
            vals = .Range(.Range("B5"), .Cells(.Rows.Count, 2).End(xlUp))
            For i = 1 To UBound(vals, 1)
                If vals(i, 1) = LookupValue Then
                    rv = rv & sep & .Cells(4 + i, 15).Value
                    sep = "; "
                End If
            Next i
        End With
    End If
    EmailConcat = rv

End Function
0 голосов
/ 09 января 2019

Объединение нескольких

При использовании Range или Cells и т. Д. Без квалификаторов они относятся к ActiveSheet из ActiveWorkbook.

Код

Function EmailConcat(LookupValue As String)

    Application.Volatile

    Const cFirst As String = "B5"
    Const cCol As Variant = "O"
    Dim i As Long
    Dim Result As String
    Dim LastRow As Long

    LastRow = Cells.Find("*", , xlFormulas, xlWhole, xlByRows, xlPrevious).Row

    For i = Range(cFirst).Row To LastRow
        If Cells(i, Range(cFirst).Column) = LookupValue Then
            Result = Result & Cells(i, cCol) & "; "
        End If
    Next i

    EmailConcat = Left(Result, Len(Result) - 2)

End Function
...