Excel, VBA Vlookup, multiple returns into rows

问题

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:

回答1:

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

来源：https://stackoverflow.com/questions/13145011/excel-vba-vlookup-multiple-returns-into-rows

标签

excel

vba

vlookup