Question

我编写了以下函数，该函数基本上VLOOKUPs将与值VLOOKUPd相关的所有结果都存储在一个列表中。

例如

如果我们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

您可以考虑像这样使用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()运行起来非常快，您不必重复整个搜索范围。

Answer 2

@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 3

您尚未提供有关如何部署UDF的任何信息，但我敢打赌，这至少是问题的一半。

我敢打赌，您正在为A列中的每个重复项创建连接字符串。此外，我认为您很有可能正在使用完整的列引用。

我将假设您的数据从第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中的上述公式。它在A1：A9中寻找与A10的匹配项；如果找到，它将从C列中的相关行返回先前连接的字符串。如果未找到，则将仅从A列的第10行开始的标识符以及B列的第10行开始的标识符构建一个新的串联字符串。到包含B列中最后一个数字的行。

VBA优化代码以加快运行速度，用户创建的功能太慢

3 个答案: