返回VBA vlookup中的第二个值

Question

我相信这很容易，但无法找到一种方法来做到这一点。我试图计算列A中的范围，如果<2，那么可以只是一个常规的vlookup返回一个答案，但如果大于2，我希望vlookup返回第一个答案在列9然后在列10等第二个，有人能帮助吗?希望你能理解，谢谢。

    If (Application.WorksheetFunction.CountIf _       
 (data.Range("A:A"), ThisWorkbook.Sheets("Sheet2").Cells(r, 2).Value)) < 2 _
        Then
        toh = Application.WorksheetFunction.VLookup _
        (ThisWorkbook.Sheets("Sheet2").Cells(r, 2).Value, data.Range("A:N"), 14, False)
        Cells(r, 9) = toh

Answer 1

下面的函数可以让您了解vloopkup是如何工作的函数f_Apply_VlookupCalculation_Formulas(arrLookupWs, arrlookupRange, lookupColNo)' arrlookurange = "$A$2:$E$2413"'arrLookupWs = Array("DD"， "MM")'lookupColNo = 5intRowCount = Int(ActiveSheet.UsedRange.Count)关于错误继续下一步For x = 2 To intRowCountActiveSheet。单元格(x, 4). value =应用程序。工作表函数。vlookup(活动表。cell (x, 1).Value, Sheets(arrLookupWs(0)).Range(arrlookupRange(0))， lookupColNo - 1,0)ActiveSheet。单元格(x, 5). value =应用程序。工作表函数。vlookup(活动表。cell (x, 1).Value, Sheets(arrLookupWs(0)).Range(arrlookupRange(0))， lookupColNo, 0)ActiveSheet。Cells(x, 6). value = Application.WorksheetFunction.VLookup(ActiveSheet. vlookup)。cell (x, 1).Value, Sheets(arrLookupWs(1)).Range(arrlookupRange(1))， lookupColNo - 1,0)ActiveSheet。单元格(x, 7). value =应用程序。工作表函数。vlookup(活动表。cell (x, 1).Value, Sheets(arrLookupWs(1)).Range(arrlookupRange(1))， lookupColNo, 0)下一个出错时，返回0消除arrLookupWs消除arrlookupRange结束函数

Answer 2

可以使用array formula

这将给出第一个，正常的vlookup

=INDEX(I$1:I$13,SMALL(IF($A$1:$A$13=$A$15,ROW($A$1:$A$13)),1),1)

这将得到第二个

=INDEX(J$1:J$13,SMALL(IF($A$1:$A$13=$A$15,ROW($A$1:$A$13)),**2**),1)

这是第三个，星号每次递增，删除星号

=INDEX(K$1:K$13,SMALL(IF($A$1:$A$13=$A$15,ROW($A$1:$A$13)),**3**),1)

不确定您是否正在使用VBA用于工作表函数或不在更大的函数中。

之类的，这里look for是你要做的数据所在的单元格，checkvalue是列a，输入范围是你想要的返回值，列8到.....column是返回值，要得到第二个值，与公式id相同的数据使用

VLOOKUP_NEW (range("a15"),range("a1:a13"),range("i1:k13"),2)

Public Function VLOOKUP_NEW(rngLookFor As Excel.Range, _
                        rngCheckValues As Excel.Range, _
                        rngInputRange As Excel.Range, _
                        colReturn As Integer) As Variant
Dim c As Excel.Range
Dim arrRows() As Long
On Error GoTo eHandle
For Each c In rngCheckValues.Cells
    If c.Value = rngLookFor.Value Then
        arrRows(UBound(arrRows)) = c.Row
        ReDim Preserve a(UBound(arrRows) + 1)
    End If
Next c
VLOOKUP_NEW = WorksheetFunction.Index(rngInputRange, arrRows(colReturn - 1), colReturn)
Exit Function
eHandle:
    If Err.Number = 9 Then
        ReDim arrRows(0)
        Resume
    End If
End Function

Answer 3

你试试这个:

Option Explicit
Sub main()
    Dim valToSearch As Variant
    Dim Data As Range
    Dim nFilt As Long, r As Long, iArea As Long, iCount As Long, iAreaRow As Long
    r = 3 '<-- just for testing purposes
    Set Data = ThisWorkbook.Sheets("Data").Range("A1:N20") '<-- just for testing purposes

    valToSearch = ThisWorkbook.Sheets("Sheet2").Cells(r, 2).Value'<-- store the value to search
    With Data '<-- refer to 'Data' range 
        .AutoFilter field:=1, Criteria1:=valToSearch '<--| filter first column of Data range on 'valToSearch' 
        nFilt = Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) - 1 '<--  count filtered values, assuming there's a header row I subtract 1 not to count its always visible row
        If nFilt > 0 Then '<-- if at least 1 data row filtered
            With .Offset(1).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible) '<-- refer to 'Data' range filtered values header excluded 
                For iArea = 1 To .Areas.Count '<-- loop through areas
                    For iAreaRow = 1 To .Areas(iArea).Rows.Count '<-- loop through area rows
                        ThisWorkbook.Sheets("Sheet2").Cells(r, 9 + iCount) = .Areas(iArea).Cells(iAreaRow, 14) '<-- paste single filtered value in "Sheet2" cell starting from column 14 and offsetting one column rightwards at every pasting
                        iCount = iCount + 1 '<-- update pasted cells counter
                        If iCount = nFilt Then Exit For '<-- exit if pasted as many cells as filtered
                    Next iAreaRow
                    If iCount = nFilt Then Exit For '<-- exit if pasted as many cells as filtered
                Next iArea
            End With
        End If
        .Parent.AutoFilterMode = False '<-- shows unfiltered (hidden) rows back
    End With
End Sub