2017-01-03 88 views
0

enter image description hereenter image description here我试图得到多个VLOOKUP在单细胞多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 
+0

你的代码是伟大的,你忘了一个小东西,从你的'Function'返回'String'。将第一行修改为'Function MultipleLookupNoRept(Lookupvalue As String,LookupRange As Range,ColumnNumber As Integer)As String',它可以为你工作 –

+0

谢谢但是我再次遇到同样的错误 –

+0

你怎么使用它?您是从Excel工作表中输入正确的参数? –

回答

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 
+0

感谢工作正常。 –

+0

嗨需要对此代码进行一次更改。如果结果在复制其考虑只有一个(见我附上的截图) –

+0

修订后的代码。请尝试 – nightcrawler23

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