Excel，VBA Vlookup，多次返回到行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/13145011/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel, VBA Vlookup, multiple returns into rows
提问by Sean Mc
Very new to VBA, so please excuse my ignorance.
对 VBA 非常陌生，所以请原谅我的无知。
How would you alter the code below to return the result into rows as opposed to a string?
您将如何更改下面的代码以将结果返回到行而不是字符串中？
Thanks in advance....
提前致谢....
data
数据
Acct No CropType
------- ---------
0001 Grain
0001 OilSeed
0001 Hay
0002 Grain
function
功能
=vlookupall("0001", A:A, 1, " ")
Here is the code:
这是代码：
Function VLookupAll(ByVal lookup_value As String, _
ByVal lookup_column As range, _
ByVal return_value_column As Long, _
Optional seperator As String = ", ") As String
Application.ScreenUpdating = False
Dim i As Long
Dim result As String
For i = 1 To lookup_column.Rows.count
If Len(lookup_column(i, 1).text) <> 0 Then
If lookup_column(i, 1).text = lookup_value Then
result = result & (lookup_column(i).offset(0, return_value_column).text & seperator)
End If
End If
Next
If Len(result) <> 0 Then
result = Left(result, Len(result) - Len(seperator))
End If
VLookupAll = result
Application.ScreenUpdating = True
End FunctionNotes:
回答by mkingston
Try this:
尝试这个：
Option Explicit
Function VLookupAll(ByVal lookup_value As String, _
ByVal lookup_column As Range, _
ByVal return_value_column As Long) As Variant
Application.ScreenUpdating = False
Dim i As Long, _
j As Long
Dim result() As Variant
ReDim result(1 To Application.Caller.Rows.Count, 1 To 1) As Variant
j = LBound(result)
For i = 1 To lookup_column.Rows.Count
If Len(lookup_column(i, 1).Text) <> 0 Then
If lookup_column(i, 1).Text = lookup_value Then
If j > UBound(result, 1) Then
Debug.Print "More rows required for output!"
Exit For
End If
result(j, 1) = lookup_column(i).Offset(0, return_value_column).Text
j = j + 1
End If
End If
Next
VLookupAll = result
Application.ScreenUpdating = True
End Function
Now, when entering the formula on your sheet, select three cells, one above the other, then type the following:
现在，在工作表上输入公式时，选择三个单元格，一个在另一个上方，然后键入以下内容：
=vlookupall("0001",$A:$A, 1, " ")
And press ctrl+shift+enter to enter the formula.
然后按 ctrl+shift+enter 输入公式。
Note that if you have selected too few rows for output, your immediate window (press ctrl+g when in the vb editor) will display a message "More rows required for output!". I had this as a messagebox, but with automatic calculation on it gets a bit crazy..
请注意，如果您选择的输出行太少，您的即时窗口（在 vb 编辑器中按 ctrl+g）将显示一条消息“输出需要更多行！”。我把它作为一个消息框，但是自动计算它变得有点疯狂..
回答by san-jrel Sy
How to use above code like an array?
如何像数组一样使用上面的代码？
=VLookupAll(Main!$B$1,'Tes'!$A1:$A$1500,{1,2})
=VLookupAll(Main!$B$1,'Tes'!$A1:$A$1500,{1,2})
