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

您可以考虑使用Range对象的Find()方法，如下所示：

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只是打败了我，但无论如何都想发布我的代码。 :)
这将适用于排序列表，如果未找到lookupval则返回#N/A。

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 列中的关联行返回先前连接的字符串。如果未找到，它将构建一个新的串联字符串，但仅从第 10 行开始的标识符 A 列和 B 列中从第 10 行开始的值向下到包含列 B 中最后一个数字的行。