多个Vlookup结果

时间:2017-01-03 07:02:59

标签: excel excel-vba vba

enter image description here enter image description here我试图在单个单元格中获得多个vlookup

我正在使用以下功能 #VALUE!错误,需要帮助才能更正代码

MultipleLookupNoRept(Lookupvalue As String, LookupRange As Range, ColumnNumber As Integer)
Dim i As Long
Dim Result As String
For i = 1 To LookupRange.Columns(1).Cells.Count
  If LookupRange.Cells(i, 1) = Lookupvalue Then
    For J = 1 To i - 1
    If LookupRange.Cells(J, 1) = Lookupvalue Then
      If LookupRange.Cells(J, ColumnNumber) = LookupRange.Cells(i, ColumnNumber) Then
        GoTo Skip
      End If
    End If
    Next J
    Result = Result & " " & LookupRange.Cells(i, ColumnNumber) & ","
Skip:
  End If
Next i
MultipleLookupNoRept = Left(Result, Len(Result) - 1)
End Function

2 个答案:

答案 0 :(得分:0)

此代码适用于我。其中大部分是原始代码。

Function MultipleLookupNoRept(Lookupvalue As String, LookupRange As Range, ColumnNumber As Integer) As String
    Dim i As Long
    Dim Result As String

    For i = 1 To LookupRange.Columns(1).Cells.Count
      If LookupRange.Cells(i, 1) = Lookupvalue Then
        Result = Result & " " & LookupRange.Cells(i, ColumnNumber) & ","
      End If
    Next i
    If (Len(Result) = 0) Then
        MultipleLookupNoRept = 0
        Else
        MultipleLookupNoRept = Left(Result, Len(Result) - 1)
    End If

End Function

答案 1 :(得分:0)

'This code should help 
' Syntax =MVLOOKUP(Lookup_value,Table_array,Col_index_number)
Option Explicit
Function mvlookup(lookupValue, tableArray As Range, colIndexNum As Long, _
Optional NotUsed As Variant) As Variant

Dim initTable As Range
Dim myRowMatch As Variant
Dim myRes() As Variant
Dim myStr As String
Dim initTableCols As Long
Dim i As Long
Dim ubound_myRes As Long

Set initTable = Nothing
On Error Resume Next
Set initTable = Intersect(tableArray, _
tableArray.Parent.UsedRange.EntireRow)
On Error GoTo 0

If initTable Is Nothing Then
mvlookup = CVErr(xlErrRef)
Exit Function
End If

initTableCols = initTable.Columns.Count

i = 0
Do
myRowMatch = Application.Match(lookupValue, initTable.Columns(1), 0)

If IsError(myRowMatch) Then
Exit Do
Else
i = i + 1
ReDim Preserve myRes(1 To i)
myRes(i) _
= initTable(1).Offset(myRowMatch - 1, colIndexNum - 1).Text
If initTable.Rows.Count <= myRowMatch Then
Exit Do
End If
On Error Resume Next
Set initTable = initTable.Offset(myRowMatch, 0) _
.Resize(initTable.Rows.Count - myRowMatch, _
initTableCols)
On Error GoTo 0
If initTable Is Nothing Then
Exit Do
End If
End If
Loop

If i = 0 Then
mvlookup = CVErr(xlErrNA)
Exit Function
End If

myStr = ""
For i = LBound(myRes) To UBound(myRes)
myStr = myStr & ", " & myRes(i)
Next i

mvlookup = Mid(myStr, 3)

End Function
相关问题