今天也在勤劳工作呀 2023-06-07 13:01 采纳率: 50%
浏览 132
已结题

【提问】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实现吗?代码实例,请教。

img

img

  • 写回答

4条回答 默认 最新

  • threenewbee 2023-06-07 13:24
    关注
    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
    
    
    评论

报告相同问题?

问题事件

  • 已结题 (查看结题原因) 6月9日
  • 修改了问题 6月7日
  • 创建了问题 6月7日