对VBA来说很新,所以请原谅我的无知。
如何更改下面的代码以将结果返回到行而不是字符串?
提前致谢....
数据
Acct No CropType
------- ---------
0001 Grain
0001 OilSeed
0001 Hay
0002 Grain
功能
=vlookupall("0001", A:A, 1, " ")
以下是代码:
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:
答案 0 :(得分:1)
试试这个:
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
现在,在工作表上输入公式时,选择三个单元格,一个在另一个上面,然后输入以下内容:
=vlookupall("0001",$A:$A, 1, " ")
然后按ctrl + shift + enter输入公式。
请注意,如果您选择了太少的行进行输出,则您的即时窗口(在vb编辑器中按ctrl + g)将显示消息“输出需要更多行!”。我有这个作为消息框,但自动计算它有点疯狂..
答案 1 :(得分:0)
如何像数组一样使用上面的代码?
= VLookupAll(Main!$ B $ 1,'Tes'!$ A1:$ A $ 1500,{1,2})