Excel，VBA Vlookup，多个返回行 [英] Excel, VBA Vlookup, multiple returns into rows

问题描述

对于VBA来说非常新鲜，所以请原谅我的无知。

如何更改下面的代码将结果返回到行而不是字符串？

提前感谢...

数据

  Acct No CropType 
 ------- --------- 
 0001粮食
 0001 OilSeed 
 0001 Hay 
 0002粮食
  

功能

  = vlookupall（0001，A：A，1，）
  

这是代码：

 功能VLookupAll（ByVal lookup_value As String，_ 
 ByVal lookup_column作为范围，_ 
 ByVal return_value_column As Long，_ 
可选的分隔符As String =，）As String 
 
 Application.ScreenUpdating = False 
 Dim i As Long 
 Dim result As String 
 
 For i = 1 To lookup_column.Rows.count 
如果Len（lookup_column（i，1）.text）<> 0然后
如果lookup_column（i，1）.text = lookup_value然后
 result = result& （lookup_column（i）.offset（0，return_value_column）.text& seperator）
 End If 
 End If 
 Next 
 
如果Len（result） > 0然后
 result = Left（result，Len（result） -  Len（seperator））
 End If 
 
 VLookupAll = result 
 Application.ScreenUpdating = True 
 
结束功能注释：
  

解决方案

：

  Option Explicit 
 
函数VLookupAll（ByVal lookup_value As String，_ 
 ByVal lookup_column作为范围，_ 
 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）
 
对于i = 1 To lookup_column.Rows.Count 
如果Len（lookup_column（i，1）.Text）<> 0然后
如果lookup_column（i，1）.Text = lookup_value然后
如果j> UBound（result，1）然后
 Debug.Print输出需要更多行！ 
退出
结束If 
 result（j，1）= lookup_column（i）.Offset（0，return_value_column）.Text 
j = j + 1 
 End If 
结束如果
下一个
 
 VLookupAll = result 
 Application.ScreenUpdating = True 
 
结束函数
  

现在，在您的工作表上输入公式时，选择三个单元格，一个在另一个单元格上，然后键入以下内容：

  = vlookupall（0001，$ A：$ A，1，）
  

然后按ctrl + shift + enter输入公式。

请注意，如果您选择太少行输出，您的直接窗口（在vb编辑器中按ctrl + g）将显示一条消息输出需要更多行！。我把它当作一个消息框，但是自动计算它有点疯狂。

Very new to VBA, so please excuse my ignorance.

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:

解决方案

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.

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..

这篇关于Excel，VBA Vlookup，多个返回行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！