如何将多条件XLOOKUP函数转换为VBA代码提升工作簿速度？

原代码存在的问题 #

• 变量名错误：代码中定义了LR对应Sheet1的J列，但后续使用了未定义的LR1
• 整列运算效率极低，且VBA中无法直接对整列执行(LR1 <= R4) * (LR1 >= R) * (LR2 = R2)这类数组逻辑运算
• 未针对批量数据处理，直接给整列赋值的逻辑不符合XLOOKUP的使用规则
• 目标范围不符：需求是写入Sheet1的B2至最后一行，但代码中设置为了C列

优化后的VBA代码（高效批量处理） #

以下代码通过数组读取数据，批量计算并写入结果，大幅提升运行速度：

Sub MultiConditionXLookup()
    Dim wb As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow1 As Long, lastRow2 As Long
    Dim lookupArr As Variant, matchArrE As Variant, matchArrG As Variant, matchArrH As Variant, returnArr As Variant
    Dim resultArr As Variant
    Dim i As Long
    
    Set wb = ThisWorkbook
    Set ws1 = wb.Sheets("Sheet1")
    Set ws2 = wb.Sheets("Sheet2")
    
    '获取有效数据行（根据实际数据列调整，这里用J列判断Sheet1的最后一行）
    lastRow1 = ws1.Cells(ws1.Rows.Count, "J").End(xlUp).Row
    lastRow2 = ws2.Cells(ws2.Rows.Count, "E").End(xlUp).Row 'Sheet2的有效数据行
    
    '将数据读入数组（避免反复访问工作表，提升速度）
    lookupArr = ws1.Range("F2:J" & lastRow1).Value 'Sheet1的F列（匹配值）和J列（区间值）
    matchArrE = ws2.Range("E2:E" & lastRow2).Value 'Sheet2的E列匹配值
    matchArrG = ws2.Range("G2:G" & lastRow2).Value 'Sheet2的G列区间下限
    matchArrH = ws2.Range("H2:H" & lastRow2).Value 'Sheet2的H列区间上限
    returnArr = ws2.Range("L2:L" & lastRow2).Value 'Sheet2的返回值列
    
    '初始化结果数组
    ReDim resultArr(1 To UBound(lookupArr, 1), 1 To 1)
    
    '循环计算每一行的结果
    For i = 1 To UBound(lookupArr, 1)
        On Error Resume Next '捕获无匹配的错误
        resultArr(i, 1) = Application.XLookup(1, _
            (lookupArr(i, 5) <= matchArrH) * (lookupArr(i, 5) >= matchArrG) * (lookupArr(i, 1) = matchArrE), _
            returnArr, "N/A")
        On Error GoTo 0
    Next i
    
    '将结果写入Sheet1的B2至最后一行
    ws1.Range("B2:B" & lastRow1).Value = resultArr
End Sub

代码说明 #

• 数组读取：将所有需要用到的数据一次性读入内存数组，避免反复访问工作表，这是提升VBA运行速度的关键
• 错误处理：使用On Error Resume Next捕获无匹配的情况，返回指定的"N/A"
• 范围控制：仅处理有效数据行，而非整列，减少不必要的运算

另一种简化写法（直接使用单元格范围，适合小规模数据） #

如果数据量不大，也可以用以下更直观的写法：

Sub SimpleMultiXLookup()
    Dim wb As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow1 As Long
    Dim rng As Range
    
    Set wb = ThisWorkbook
    Set ws1 = wb.Sheets("Sheet1")
    Set ws2 = wb.Sheets("Sheet2")
    
    lastRow1 = ws1.Cells(ws1.Rows.Count, "J").End(xlUp).Row
    
    '遍历每一行写入结果
    For Each rng In ws1.Range("B2:B" & lastRow1)
        rng.Value = Application.XLookup(1, _
            (ws1.Cells(rng.Row, "J") <= ws2.Range("H:H")) * (ws1.Cells(rng.Row, "J") >= ws2.Range("G:G")) * (ws1.Cells(rng.Row, "F") = ws2.Range("E:E")), _
            ws2.Range("L:L"), "N/A")
    Next rng
End Sub

注意：这种写法每次循环都访问工作表，数据量大时速度会较慢，优先推荐第一种数组批量处理的方式。

内容的提问来源于stack exchange，提问作者Luke K