[已解决]如何用VBA，满足两个条件返回值。谢谢。

新一

如何用VBA，满足两个条件返回值。如附件，查询表的黄色底纹为条件，返回条件值为D列。在表一中，如果有满足条件，则可以得出查找结果。谢谢。结果为表一的数据。表一的值是根据查询表所得

最佳答案

月排行榜 / 总排行榜

qh8600

2015-1-1 10:45

表.rar (8.24 KB, 下载次数: 8)

2015-1-1 10:45 上传

点击文件名下载附件
楼主试试

跳转到最佳答案楼层

qh8600

1. Sub demo()
   
2.     Dim d, ar, str, i, j
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     ar = Sheets("查询表").Range("a2:d" & Sheets("查询表").Cells(Rows.Count, 1).End(3).Row)
   
5.     For i = 1 To UBound(ar)
   
6.         str = ar(i, 1) & "," & ar(i, 3)
   
7.         d(str) = ar(i, 4)
   
8.     Next
   
9.     br = Sheets("表一").Range("c3").CurrentRegion
   
10.     For i = 3 To UBound(br)
    
11.         For j = 3 To UBound(br, 2)
    
12.             br(i, j) = d(br(1, j) & "," & br(i, 2))
    
13.         Next
    
14.     Next
    
15.     Sheets("表一").Range("a1").Resize(UBound(br), UBound(br, 2)) = br
    
16. End Sub

复制代码

附件楼下

qh8600

表.rar (8.24 KB, 下载次数: 8)

2015-1-1 10:45 上传

点击文件名下载附件
楼主试试

dsmch

应该是满足三个条件

1. Sub Macro1()
   
2. Dim arr, brr, crr, d, i&, j%, zf$
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Sheet1.Activate
   
5. arr = Range("a3").CurrentRegion
   
6. brr = Sheet2.Range("a1").CurrentRegion
   
7. ReDim crr(1 To UBound(arr) - 2, 1 To UBound(arr, 2) - 2)
   
8. For i = 2 To UBound(brr)
   
9. zf = brr(i, 1) & "," & brr(i, 2) & "," & brr(i, 3)
   
10. d(zf) = brr(i, 4)
    
11. Next
    
12. For i = 3 To UBound(arr)
    
13.     For j = 3 To UBound(arr, 2)
    
14.         zf = arr(1, j) & "," & arr(2, j) & "," & arr(i, 2)
    
15.         crr(i - 2, j - 2) = d(zf)
    
16.     Next
    
17. Next
    
18. Range("c3").Resize(UBound(crr), UBound(crr, 2)) = crr
    
19. End Sub

复制代码

新一

谢谢老师们的帮助。{:011:}