如何用VBA查找符合条件的行并复制到指定位置

Question

比如我在图一指定位置输入相应的产品规格，客户，定重。然后能够实现在图二的表格里将符合条件的那一行查询出来，并复制到图一的指定位置A7位置，求大神帮忙

Answer 1

Sub dls()
        Dim i As Long
        Dim arr, brr, d
        Dim max_row As Long
        
        max_row = Sheet2.[a:d].Find("*", , xlValues, , , xlPrevious).Row    '获取数据列表最大行
        arr = Sheet2.Range("a2:d" & max_row)                                            '列表赋值到数组arr
        Set d = CreateObject("scripting.dictionary")                                    '新建字典
        
        For i = 1 To UBound(arr)                                                                        '字典赋值
                d(arr(i, 1) & arr(i, 2) & arr(i, 3)) = arr(i, 4)
        Next
        brr = Sheet1.Range("b2:b4")
        If d.exists(brr(1, 1) & brr(2, 1) & brr(3, 1)) Then                             '如果字典存在满足查询的条件，则
                Sheet1.Range("a7:d7").Clear
                Sheet1.Range("a7:d7") = Application.Transpose(brr)
                Sheet1.Range("d7") = d(brr(1, 1) & brr(2, 1) & brr(3, 1))
        Else: MsgBox "no"                                                                                  '如果不存在，则.....
        End If
End Sub