【提问】VBA实现跨表格查找满足多条件的数据并提取

前提：同一工作簿，6个sheet，sheet1最后一列为提取数据最后需要放置的位置。

需实现功能：
1.遍历sheet2-6, 查找满足sheet1中的A列的数据。
2.满足A列的条件下，遍历sheet2-6，查找满足sheet1中的B列。
3.满足A和B的条件下，判断对应sheet1中C列数据，在A和B条件下的目标sheet中的C列中的哪一行哪一列。
4.将3中查找到的结果里的数据乘以sheet1中C列的查找源，得到最终结果。
5.将4的最终结果，写入sheet1中的D列。

感谢前4楼的解答，文字可能描述没那么清楚，导致理解有偏差，补充图片如下：
其实就是想通过表1的AB找到对应表2-6的每千克材料的单价，然后单价×表1的实际重量得到最终表1需要写入的单价。麻烦的是要判断表1中的C在表2-6中的哪个区间里，才能在表2-6中找到对应的每千克重量的单价。
以上功能可以通过VBA实现吗？代码实例，请教。

Sub getData()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, ws5 As Worksheet, ws6 As Worksheet
    Dim lastRow1 As Long, lastRow2 As Long, lastRow3 As Long, lastRow4 As Long, lastRow5 As Long, lastRow6 As Long
    Dim i As Long, j As Long, k As Long, l As Long
    Dim targetRow As Long, targetCol As Long
    Dim targetValue As Double
    
    '获取sheet对象
    Set ws1 = ActiveWorkbook.Sheets("Sheet1")
    Set ws2 = ActiveWorkbook.Sheets("Sheet2")
    Set ws3 = ActiveWorkbook.Sheets("Sheet3")
    Set ws4 = ActiveWorkbook.Sheets("Sheet4")
    Set ws5 = ActiveWorkbook.Sheets("Sheet5")
    Set ws6 = ActiveWorkbook.Sheets("Sheet6")
    
    '获取sheet1的最后一行
    lastRow1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
    
    '循环sheet1中的每一行，查找对应数据
    For i = 2 To lastRow1
        '获取目标A列数据
        targetValue = ws1.Cells(i, 1).Value
        
        '查找目标B列数据
        For j = 2 To lastRow2
            If ws2.Cells(j, 1).Value = targetValue Then
                '查找目标C列数据
                For k = 2 To lastRow3
                    If ws3.Cells(k, 1).Value = targetValue And ws3.Cells(k, 2).Value = ws1.Cells(i, 2).Value Then
                        '查找目标C列数据在哪一行哪一列
                        For l = 1 To ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column
                            If ws1.Cells(1, l).Value = ws3.Cells(1, l).Value Then
                                targetCol = l
                                Exit For
                            End If
                        Next l
                        targetRow = k
                        '计算结果
                        targetValue = targetValue * ws3.Cells(targetRow, targetCol).Value
                        '写入结果
                        ws1.Cells(i, 4).Value = targetValue
                    End If
                Next k
            End If
            '在其他sheet中同样进行以上查找操作
            '...
        Next j
    Next i
End Sub

可以通过VBA实现这些功能。以下是一个示例的VBA代码，实现了你提到的功能：

Sub ProcessData()
    Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim ws As Worksheet
    Dim lastRow1 As Long
    Dim lastRow As Long
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim targetRow As Long
    Dim targetCol As Long
    Dim finalResult As Double
    
    ' 打开工作簿
    Set wb = ThisWorkbook
    ' 获取Sheet1
    Set ws1 = wb.Sheets("Sheet1")
    ' 获取Sheet1最后一行
    lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历Sheet2-6
    For i = 2 To 6
        ' 获取当前Sheet
        Set ws = wb.Sheets("Sheet" & i)
        ' 获取当前Sheet最后一行
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        
        ' 遍历Sheet1中的A列数据
        For j = 2 To lastRow1
            ' 检查A列数据是否满足条件
            If ws.Cells(j, "A").Value = ws1.Cells(j, "A").Value Then
                ' 遍历Sheet1中的B列数据
                For k = 2 To lastRow1
                    ' 检查B列数据是否满足条件
                    If ws.Cells(k, "B").Value = ws1.Cells(k, "B").Value Then
                        ' 获取目标Sheet中的C列对应数据的位置
                        targetRow = ws1.Cells(k, "C").Row
                        targetCol = ws1.Cells(k, "C").Column
                        ' 计算最终结果
                        finalResult = ws.Cells(targetRow, targetCol).Value * ws1.Cells(j, "C").Value
                        ' 将最终结果写入Sheet1的D列
                        ws1.Cells(j, "D").Value = finalResult
                    End If
                Next k
            End If
        Next j
    Next i
    
    ' 关闭工作簿
    wb.Close SaveChanges:=True
    
    ' 释放对象
    Set ws = Nothing
    Set ws1 = Nothing
    Set wb = Nothing
End Sub

你可以将这段VBA代码插入到工作簿中的模块中，并调用ProcessData子程序来执行整个过程。这段代码会遍历Sheet2-6，根据Sheet1中的A列和B列的条件，在目标Sheet中找到对应的位置，并计算最终结果，然后将结果写入Sheet1的D列。

注意：在使用此代码之前，请确保在工作簿中已经存在Sheet1和Sheet2-6，并且它们的列与你提到的列相匹配。

应该是可以的吧
可以参考试试

Sub ProcessData()
    Dim wb As Workbook
    Dim wsSrc As Worksheet, wsDst As Worksheet
    Dim rngSrc As Range, rngDst As Range
    Dim lastRow As Long, lastCol As Long
    Dim i As Long, j As Long, k As Long
    Dim found As Boolean
    Dim srcValue As Double, dstValue As Double
    
    Set wb = ThisWorkbook
    Set wsSrc = wb.Sheets("Sheet1")
    Set rngSrc = wsSrc.Range("A1:C" & wsSrc.Cells.SpecialCells(xlCellTypeLastCell).Row)
    
   //循环通过表1中的每一行，从第2行开始（即跳过标题行）
    For i = 2 To rngSrc.Rows.Count
        // 获取表1中A、B和C列的搜索条件
        Dim searchTextA As String
        Dim searchTextB As String
        Dim searchValueC As Double
        searchTextA = rngSrc.Cells(i, 1).Value
        searchTextB = rngSrc.Cells(i, 2).Value
        searchValueC = rngSrc.Cells(i, 3).Value
        
        //初始化写入结果的目标范围
        Set wsDst = wsSrc
        Set rngDst = wsDst.Cells(rngSrc(i, 3).Row, rngSrc(i, 3).Column + 1)
        
      //循环浏览每张表2-6以查找匹配的数据
        For j = 2 To 6
            Set wsSrc = wb.Sheets("Sheet" & j)
            Set rngSrc = wsSrc.Range("A1")
            lastRow = wsSrc.Cells.SpecialCells(xlCellTypeLastCell).Row
            lastCol = wsSrc.Cells.SpecialCells(xlCellTypeLastCell).Column
            
            found = False
            
          //循环浏览表2-6中的每一行，在A列和B列中查找匹配的数据
            For k = 2 To lastRow
                If rngSrc.Offset(k - 1, 0).Value = searchTextA And rngSrc.Offset(k - 1, 1).Value = searchTextB Then
                    found = True
                    
                    //在表2-6的C列中获取值
                    srcValue = rngSrc.Offset(k - 1, 2).Value
                    
                   //获取表1中相应单元格的行号和列号
                    Dim dstRow As Long
                    Dim dstCol As Long
                    dstRow = rngDst.Row - 1 + k
                    dstCol = rngDst.Column
                    
                   //获取表1的C列中的值以进行相乘
                    dstValue = wsDst.Cells(dstRow, 3).Value
                    
                   //计算最终值并写入结果范围
                    rngDst.Offset(k - 1, 0).Value = srcValue * dstValue
                    
                End If
            Next k
            
            //如果在表2-6中找不到数据，则将0写入结果范围
            If Not found Then
                rngDst.Value = 0
            End If
        Next j
    Next i
End Sub

可以使用VBA实现这个需求。以下是一个示例代码，你可以根据自己的实际情况进行修改：

Sub SearchAndMultiply()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, ws5 As Worksheet, ws6 As Worksheet
    Dim lastRow1 As Long, lastRow2 As Long, lastRow3 As Long, lastRow4 As Long, lastRow5 As Long, lastRow6 As Long
    Dim i As Long, j As Long, k As Long, l As Long
    Dim searchValueA As Variant, searchValueB As Variant, searchValueC As Variant
    Dim targetRow As Long, targetCol As Long
    Dim finalResult As Double
    
    ' 获取各个工作表对象
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    Set ws3 = ThisWorkbook.Sheets("Sheet3")
    Set ws4 = ThisWorkbook.Sheets("Sheet4")
    Set ws5 = ThisWorkbook.Sheets("Sheet5")
    Set ws6 = ThisWorkbook.Sheets("Sheet6")
    
    ' 获取Sheet1最后一行和最后一列
    lastRow1 = ws1.Cells(Rows.Count, "A").End(xlUp).Row
    lastCol1 = ws1.Cells(1, Columns.Count).End(xlToLeft).Column
    
    ' 遍历Sheet1中每行数据
    For i = 2 To lastRow1
        ' 获取当前行要查找的值
        searchValueA = ws1.Cells(i, "A").Value
        searchValueB = ws1.Cells(i, "B").Value
        searchValueC = ws1.Cells(i, "C").Value
        
        ' 遍历Sheet2-6，查找满足条件的行和列
        For j = 2 To lastRow2
            If ws2.Cells(j, "A").Value = searchValueA And ws2.Cells(j, "B").Value = searchValueB Then
                targetRow = j
                targetCol = lastCol1 ' Sheet1最后一列为目标列
                Exit For
            End If
        Next j
        
        For k = 2 To lastRow3
            If ws3.Cells(k, "A").Value = searchValueA And ws3.Cells(k, "B").Value = searchValueB Then
                targetRow = k
                targetCol = lastCol1 ' Sheet1最后一列为目标列
                Exit For
            End If
        Next k
        
        For l = 2 To lastRow4
            If ws4.Cells(l, "A").Value = searchValueA And ws4.Cells(l, "B").Value = searchValueB Then
                targetRow = l
                targetCol = lastCol1 ' Sheet1最后一列为目标列
                Exit For
            End If
        Next l
        
        ' 根据得到的行和列计算最终结果，并写入Sheet1中
        finalResult = ws1.Cells(i, "C").Value * ws2.Cells(targetRow, targetCol).Value
        ws1.Cells(i, "D").Value = finalResult
    Next i
End Sub

需要注意的是，以上代码可能存在一些语法错误或逻辑问题，需要根据自己的实际情况进行修改。另外，建议在执行代码之前先备份一下工作簿，以防不必要的损失。