我想在 vba 中创建一个 Excel 函数，其工作方式与 VLOOKUP 相同，但有一个额外的参数让您选择第 n 个唯一的结果。
这是我目前编写的不起作用的代码。它不起作用，而且有点不完整，但我想您能明白我的意思。
Function MVLOOKUP(lookup_value, table_array As Range, col_index_num As Long, entry_num As Long, Optional range_lookup As Boolean) As Variant
'===========================
'Purpose: VLOOKUP but it finds ALL the matching entries, not just the first one.
'returns the entry you want by its number, starting at one
'entry_num is the entry to return
'most of this copied from top answer on this stackoverflow entry
'https://stackoverflow.com/questions/20676260/modified-vlookup-in-vba-excel
Dim FoundCell As Range
Dim LastCell As Range
Dim FirstAddr, find_value As String
Dim rFound As Variant
Dim strFound() As String
Dim my_range As Range
Dim row_count, col_count As Long
Dim vLookAt As Integer
col_count = table_array.Columns.Count
find_value = lookup_value
If col_index_num >= 0 Then 'sets range to do only be 1 column wide???
Set my_range = table_array.Resize(, 1)
Else
Set my_range = table_array.Resize(, 1).Offset(0, col_count - 1)
End If
With my_range 'no idea why this is here
row_count = .Cells.Count
If row_count = 1048576 Then row_count = .Cells(.Cells.Count).End(xlUp).Row
End With
Set my_range = my_range.Resize(row_count)
Set LastCell = my_range.Cells(my_range.Cells.Count)
If IsMissing(range_lookup) Or range_lookup Then
vLookAt = 2 'xlPart
Else
vLookAt = 1 'xlWhole
End If
' If IsMissing(range_lookup) Or range_lookup Then
' Set FoundCell = my_range.Find(what:=find_value, after:=LastCell, LookIn:=xlFormulas, _
' LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
' MatchCase:=False, SearchFormat:=False)
' Else
' Set FoundCell = my_range.Find(what:=find_value, after:=LastCell, LookIn:=xlFormulas, _
' LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
' MatchCase:=False, SearchFormat:=False)
' End If
Set FoundCell = my_range.Find(what:=find_value, after:=LastCell, LookIn:=xlValues, _
LookAt:=vLookAt, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not FoundCell Is Nothing Then 'We found something!
i = 0
rFound(i) = FoundCell.Address
strFound(i) = rFound(i).Offset(0, col_index_num - 1)
If IsNumeric(col_index_num) And Abs(col_index_num) <= col_count Then
'search, if found, search (for each) current array,
Do
'probably should just set last cell at the end of every loop? or use MSDN example for findnext??????
Set FoundCell = my_range.FindNext(after:=rFound(i))
rFound(i) = FoundCell.Address
If rFound(i) = rFound(0) Then
MVLOOKUP = CVErr(xlErrNA)
Exit Function
End If
If NewElem(rFound(i).Value, strFound()) Then 'only iterate i if there was a new element
strFound(i) = rFound(i).Offset(0, col_index_num - 1)
i = i + 1
End If
Loop While i < entry_num 'entry_num starts at 1, but array starts at 0
MVLOOKUP = strFound(entry_num - 1)
Exit Function
Else 'Returns #REF excel error if there's an error in the column reference
MVLOOKUP = CVErr(xlErrRef)
Exit Function
End If
Else 'Returns #N/A if notthing found
MVLOOKUP = CVErr(xlErrNA)
Exit Function
End If
End Function
Function NewElem(strCheck As String, myArray() As String) As Boolean
' For i = LBound(myArray) To UBound(myArray) - 1
' If strCheck = myArray(i) Then
' IsInArray = True
' Exit Function
' End If
' Next i
For Each i In strCheck()
myArray() = Filter(myArray, strCheck, compare:=vbTextCompare)
If (UBound(myArray) - LBound(myArray) + 1) > 0 Then
NewElem = True
Exit Function
End If
Next
NewElem = False
End Function
答案1
对于最新版本的 Excel，您可以使用 INDEX/FILTER 来实现此目的：
单元格 F15 中的公式：
=INDEX(FILTER($C$2:$C$18,$B$2:$B$18=$E$15),$E$16)
其中查找值在 E15 中，第 n 项的 n 在 E16 中。