多条件匹配并返回多值：VBA跨工作簿匹配获取行索引需求

嘿，这个需求我熟！咱们用VBA一步步实现，先理清楚逻辑，再上代码：

• 先把两个工作簿的工作表对象绑定好，避免后续因为切换工作簿搞混引用
• 从第一个工作簿（wb）的目标行里拿到「位置」和「要素类型」这两个匹配条件
• 遍历第二个工作簿（wbtemp）的所有行，找出同时满足两个条件的行，把它们的行号收集起来
• 对收集到的行号进行排序，方便后续提取数据
• （附赠）最后可以直接用排序后的行号提取目标列的值，找出最大值

Sub GetMatchedSortedRows()
    Dim wb As Workbook, wbtemp As Workbook
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim matchLoc As String, matchType As String
    Dim lastRow As Long, i As Long
    Dim matchedRows As Collection
    Dim rowArr() As Long, j As Long, temp As Long
    
    ' 替换成你的工作簿和工作表名称！
    Set wb = ThisWorkbook ' 假设wb是当前运行代码的工作簿
    Set wbtemp = Workbooks("wbtemp.xlsx") ' 确保wbtemp已经打开，或者用完整路径打开
    Set wsSource = wb.Worksheets("数据来源表") ' wb中存匹配条件的工作表
    Set wsTarget = wbtemp.Worksheets("待查找表") ' wbtemp中要搜索的工作表
    
    ' 获取wb中目标行的匹配值（这里假设是第2行，可改成你需要的行号）
    matchLoc = wsSource.Range("A2").Value ' 假设"位置"列是A列
    matchType = wsSource.Range("B2").Value ' 假设"要素类型"列是B列
    
    ' 初始化集合存储匹配到的行号
    Set matchedRows = New Collection
    
    ' 找到wbtemp工作表的最后一行，避免遍历空行
    lastRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row ' 对应"位置"列的列号
    
    ' 遍历wbtemp的行，收集匹配行号（跳过表头，从第2行开始）
    For i = 2 To lastRow
        If wsTarget.Cells(i, "A").Value = matchLoc And _
           wsTarget.Cells(i, "B").Value = matchType Then
            matchedRows.Add i ' 把符合条件的行号加入集合
        End If
    Next i
    
    ' 处理没找到匹配行的情况
    If matchedRows.Count = 0 Then
        MsgBox "哦豁，没找到任何匹配的行！"
        Exit Sub
    End If
    
    ' 把集合转成数组，方便排序
    ReDim rowArr(1 To matchedRows.Count)
    For i = 1 To matchedRows.Count
        rowArr(i) = matchedRows(i)
    Next i
    
    ' 对行号数组做升序排序（用冒泡排序，简单易懂）
    For i = LBound(rowArr) To UBound(rowArr) - 1
        For j = i + 1 To UBound(rowArr)
            If rowArr(i) > rowArr(j) Then
                temp = rowArr(i)
                rowArr(i) = rowArr(j)
                rowArr(j) = temp
            End If
        Next j
    Next i
    
    ' 输出排序后的行号到立即窗口（按Ctrl+G可以查看）
    Debug.Print "匹配到的行号（已排序）："
    For i = 1 To UBound(rowArr)
        Debug.Print rowArr(i)
    Next i
    
    ' ---------------------- 后续扩展：提取目标列最大值 ----------------------
    Dim maxVal As Double, currentVal As Double
    maxVal = -999999 ' 先设一个极小值当初始值
    For i = 1 To UBound(rowArr)
        currentVal = wsTarget.Cells(rowArr(i), "C").Value ' 假设要提取的是C列
        If currentVal > maxVal Then maxVal = currentVal
    Next i
    Debug.Print "匹配行中目标列的最大值：" & maxVal
    
    ' 释放对象，避免内存占用
    Set matchedRows = Nothing
    Set wsSource = Nothing
    Set wsTarget = Nothing
    Set wb = Nothing
    Set wbtemp = Nothing
End Sub

• 对象绑定：一定要明确指定工作簿和工作表，别用ActiveWorkbook或者ActiveSheet，不然切换窗口容易出错。
• 高效遍历优化：如果wbtemp的数据量很大，建议把整列数据读到数组里再遍历，比直接读单元格快N倍，示例代码如下：

  Dim dataArr As Variant
  dataArr = wsTarget.Range("A1:B" & lastRow).Value ' 把A、B列数据读到数组
  For i = 2 To lastRow
      If dataArr(i, 1) = matchLoc And dataArr(i, 2) = matchType Then
          matchedRows.Add i
      End If
  Next i
  

• 排序逻辑：这里用的是冒泡排序，适合小批量行号；如果行号特别多，可以改用VBA的Sort方法或者更高效的排序算法。
• 灵活调整：你可以根据实际的列位置（比如"位置"列是D列）修改代码里的列号，也可以把目标行改成循环遍历wb的多行，实现批量匹配。

内容的提问来源于stack exchange，提问作者S.Chivers