Such as in a specified location picture I enter the corresponding product specifications, customers, heavy, and then can realize in figure 2 tables will be eligible to come out of the line of the query, and figure 1 is copied to the specified location A7, o great god help

CodePudding user response:

 Sub DLS () 
Dim As Long I 
Dim arr, BRR, d 
Dim max_row As Long 

Max_row=Sheet2. [a: d]. Find (" * ", and xlValues,,, xlPrevious). The biggest the Row 'to get the data list 
Arr=Sheet2. Range (a2: "d" & amp; Max_row) 'list assign values to the array arr 
The Set d=CreateObject (" scripting. The dictionary ") 'new dictionary 

For I=1 To UBound (arr) 'dictionary assignment 
D (arr (I, 1) & amp; Arr (I, 2) & amp; Arr (I, 3))=arr (I, 4) 
Next 
BRR=Sheet1. Range (b2: "b4") 
If d.e xists (BRR (1, 1) & amp; BRR (2, 1) & amp; BRR (3, 1)) Then 'if the dictionary is satisfy the query conditions, the,,, 
Sheet1. Range (" a7: d7 "). The Clear 
Sheet1. Range (" a7: d7 ")=Application. The Transpose (BRR) 
Sheet1. Range (" d7 ")=d (BRR (1, 1) & amp; BRR (2, 1) & amp; BRR (3, 1)) 
The Else: MsgBox "no" 'if it does not exist... 
End the If 
End Sub