Excel VBA-具有多个条件的 VLOOKUP

Question

我需要一个 VBA 代码来搜索特定名称（第一个下拉菜单）、产品（第二个下拉菜单），然后返回单价。我可以使用 VLOOKUP 搜索名称并返回单价，但我需要搜索名称和产品并能够快速拉出价格。我使用了 Evaluate 函数，但结果是#VALUE！

Sub unitPrice()

Set sh4 = ThisWorkbook.Sheets("Invoice")
Set sh5 = ThisWorkbook.Sheets("Unit Price")

sh4.Range("H18") = _
sh4.Evaluate("MATCH(" & sh4.Cells(11, 1).Address(False, False) _
& "&" & sh4.Cells(18, 1).Address(False, False) _
& ",'Sh5!B2:B5&sh5!A2:A5,0)")

End Sub 

Screenshot of Invoice and Unit Price sheet

Answer 1

我假设您有两个表（插入 > 表）：tblInvoice 和 tblUnitPrice。通过listobject 在VBA 中引用它们比不使用它们要容易得多。如果您不使用表格，则必须相应地调整范围。

我的代码做了什么：它插入一个 INDEX/MATCH-Formula 来检索表中所有行的 Unitprice - 然后将纯值写回单元格。

Public Sub updateUnitPricesInInvoice()

Dim loInvoice As ListObject
Set loInvoice = ThisWorkbook.Worksheets("Invoice").ListObjects("tblInvoice")

With loInvoice.ListColumns("UnitPrice").DataBodyRange
    .Formula2 = "=INDEX(tblUnitPrices[UnitPrice],MATCH(1,(tblUnitPrices[Name]=[@Name])*(tblUnitPrices[Product]=[@Product])))"
    .value = .value
End With

End Sub

Answer 2

通过在内存中匹配来最小化与工作表的交互的替代解决方案：

Option Explicit
Sub SimpleMatch()
    Dim sh5 As Worksheet, sh4 As Worksheet 'declare vars
    Set sh4 = ThisWorkbook.Sheets("Invoice") 'set sheet
    Set sh5 = ThisWorkbook.Sheets("Unit Price") 'set sheet
    
    Dim arr, arr2, LastRowSh4 As Long, LastRowSh5 As Long
    LastRowSh4 = sh4.Cells(sh4.Rows.Count, "A").End(xlUp).Row 'count rows from last row
    LastRowSh5 = sh5.Cells(sh5.Rows.Count, "A").End(xlUp).Row 'count rows from last row
    
    arr = sh4.Range(sh4.Cells(1, 1), sh4.Cells(LastRowSh4, 8)).Value2 'load invoices to mem
    arr2 = sh5.Range(sh5.Cells(1, 1), sh5.Cells(LastRowSh5, 3)).Value2 'load prices to mem

    Dim j As Long, dict As Object
    Set dict = CreateObject("Scripting.Dictionary") 'create dictionary lateB
    With dict 'used because I'm to lazy to retype dict everywhere :)
        .CompareMode = 1 'textcompare
        For j = 1 To UBound(arr2) 'add prices to dict
            If Not .Exists(arr2(j, 1) & arr2(j, 2)) Then  'set key if I don't have it yet in dict
                .Add Key:=arr2(j, 1) & arr2(j, 2), Item:=arr2(j, 3)
            End If
        Next j
        
        Dim cust As String
        For j = 1 To UBound(arr)
            If arr(j, 1) = "Bill To:" Then
                cust = arr(j + 1, 1) 'assumes you have only  1 customer in the sheet!
            End If
            If .Exists(arr(j, 1) & cust) Then 'retrieve produc & cust price
                arr(j, 8) = dict(arr(j, 1) & cust) 'add to arr
            End If
        Next j
    End With
    
    With sh4
        .Range(.Cells(1, 1), .Cells(UBound(arr), UBound(arr, 2))) = arr 'dump updated array to invoice sheet
    End With
End Sub

Answer 3

这是没有表/列表对象的解决方案：

假设：您已在发票表上添加了以下单元格的名称

• A11：客户
• A17：标签描述
• H17：labelUnitPrice
• H28：标签总金额

在第一步中，我们检索两个标签“UnitPrice”和“TotalAmount”之间的范围 - 这就是公式所在。

然后将公式写入该范围 - 再次使用 INDEX/MATCH。 如果没有描述，则不显示任何内容（有 ISERROR）

再一次：计算公式被它们的值替换后

Option Explicit

Public Sub updateUnitPricesInInvoice()

Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Invoice")

Dim rgUnitPrices As Range
Set rgUnitPrices = getRangeBetweenTwoLabels(ws, "labelUnitPrice", "labelTotalAmount")


With rgUnitPrices
    'Excel 365
    '.Formula2 = "=IFERROR(INDEX(UnitPrice!C:C,MATCH(1,(UnitPrice!A:A=Invoice!" & ws.Range("labelDescription").Offset(1).Address(False, True) & ")*(UnitPrice!B:B=customer),0)),"""")"

    'other Excel versions
    With rgUnitPrices
        .Formula = "=IFERROR(INDEX(UnitPrice!C:C,MATCH(1,(UnitPrice!A:A=Invoice!$A" & rgUnitPrices.Rows(1).Row & ")*(UnitPrice!B:B=customer),0)),"""")"
        .FormulaArray = .FormulaR1C1
    End With
    .Value = .Value
End With

End Sub


Private Function getRangeBetweenTwoLabels(ws As Worksheet, _
    label1 As String, label2 As String)
    
Dim cStart As Range: Set cStart = ws.Range(label1).Offset(1)
Dim cEnd As Range: Set cEnd = ws.Range(label2).Offset(-1)

Set getRangeBetweenTwoLabels = ws.Range(cStart, cEnd)

End Function