Оптимизация кода VBA для более быстрой работы, созданная пользователем функция слишком медленная

Question

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

Например,

A   1
A   2
A   3
A   4
A   5
A   6
B   7
B   8
B   9
B   0

, если мы VLOOKUPпри значении A результат должен быть 1, 2, 3, 4, 5, 6

A   1   1, 2, 3, 4, 5, 6
A   2   1, 2, 3, 4, 5, 6
A   3   1, 2, 3, 4, 5, 6
A   4   1, 2, 3, 4, 5, 6
A   5   1, 2, 3, 4, 5, 6
A   6   1, 2, 3, 4, 5, 6
B   7   N/A
B   8   N/A
B   9   N/A
B   0   N/A

Но функция занимает слишком много времени для выполнения более 50 строк данных, есть ли способ заставить ее работать быстрее и, надеюсь, невылетать файл Excel?

Function MYVLOOKUP(lookupval, lookuprange As Range, indexcol As Long)

    Dim r As Range
    Dim result As String

    result = ""

    For Each r In lookuprange

        If r = lookupval Then

            If result = "" Then

                result = result & " " & r.Offset(0, indexcol - 1)

            Else

                result = result & ", " & r.Offset(0, indexcol - 1)

            End If

        End If

    Next r

    MYVLOOKUP = result

End Function

Answer 1

@ JNevill просто победил меня, но все равно хотел опубликовать мой код.:)
Это будет работать для отсортированного списка и возвращает #N/A, если lookupval не найден.

Public Function MyVlookup(lookupval As Variant, lookuprange As Range, indexcol As Long) As Variant

    Dim rFound As Range
    Dim itmCount As Long
    Dim rReturns As Variant
    Dim itm As Variant
    Dim sReturn As String

    With lookuprange

        'After looks at the last cell in first column,
        'so first searched cell is first cell in column.
        Set rFound = .Columns(1).Find( _
            What:=lookupval, _
            After:=.Columns(1).Cells(.Columns(1).Cells.Count), _
            LookIn:=xlValues, _
            LookAt:=xlWhole, _
            SearchDirection:=xlNext, _
            MatchCase:=True)

        If Not rFound Is Nothing Then

            itmCount = Application.WorksheetFunction.CountIf(lookuprange, lookupval)
            rReturns = rFound.Offset(, indexcol - 1).Resize(itmCount)

            For Each itm In rReturns
                sReturn = sReturn & itm & ","
            Next itm
            MyVlookup = Left(sReturn, Len(sReturn) - 1)

        Else
            MyVlookup = CVErr(xlErrNA)
        End If

    End With

End Function  

Редактировать - почти работает.=MyVlookup("A",$A6:$B$10,2) в примере данных возвращает #VALUE вместо 6.

Answer 2

Вы не предоставили никакой информации о том, как развертывается UDF, но держу пари, что это как минимум половина проблемы.

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

Я собираюсь предположить, что ваши данные начинаются со строки 2.

Экстентчисла в столбце B:

b2:index(b:b, match(1e99, b:b))

Степень дублирования идентификаторов в столбце A:

a2:index(a:a, match(1e99, b:b))

Если вы уже связали результат для идентификатора в столбце A, то оннамного быстрее получить этот результат сверху, чем построить его заново.Кроме того, если вы смотрите выше текущей строки, чтобы увидеть, был ли результат уже обработан и не был обработан, то нет смысла включать эти строки в текущую сборку конкатенации.

В использовании C2эту формулу и заполните до значений в столбцах A и B.

=iferror(index(c$1:C1, match(a2, a$1:a1, 0)), MYVLOOKUP(a2, a$1:index(b:b, match(1e99, b:b)), 2))

Если ваши данные действительно начинаются в строке 1, используйте эту формулу в C1.

=MYVLOOKUP(a2, a$1:index(b:b, match(1e99, b:b)), 2)

Пример:

Рассмотрим приведенную выше формулу в C10.Он ищет совпадение с A10 в A1: A9;если он найден, он возвращает ранее сцепленную строку из связанной строки в столбце C. Если он не найден, он создает новую объединенную строку, но только из идентификаторов, начинающихся в строке 10, из столбца A и значений, начинающихся со строки 10 в столбце B внизна строку, содержащую последнее число в столбце B.

Answer 3

Вы можете рассмотреть возможность использования метода Find() объекта Range, например, так:

Function MYVLOOKUP(lookupval, lookuprange As Range, indexcol As Long) As String
    Dim foundRange As Range
    Dim foundArr() As String: ReDim foundArr(0 To 0)
    Dim firstFoundAddress As String

    'perform the first find
    Set foundRange = lookuprange.Find(lookupval)

    'Capture address to avoid looping
    firstFoundAddress = foundRange.Address

    'Find values
    Do While Not foundRange Is Nothing
        'Bump the array if this isn't the first element
        If foundArr(0) <> "" Then ReDim Preserve foundArr(0 To UBound(foundArr) + 1)

        'Add to the array
        foundArr(UBound(foundArr)) = foundRange.Offset(, indexcol - 1).Value

        'Lookup next value
        Set foundRange = lookuprange.Find(What:=lookupval, After:=foundRange)

        'Exit if we looped
        If foundRange.Address = firstFoundAddress Then Exit Do
    Loop

    'join the results for output
    MYVLOOKUP = Join(foundArr, ",")
End Function

Find() очень быстро запускается, и вам не придется повторять весь диапазон поиска.