[已解决]数组与字典混合应用请各位老师帮忙解决！谢谢谢谢谢

淺喝情歌

各位老师，论坛大神们好。
   本人VBA菜鸟，想用VBA解决多个表格多条件匹配查找对应的值，然后汇总信息到一张表格中。因本人刚接触VBA不久，刚学习完兰版的视频教程数组和字典部分。尝试来解决问题时，遇到了很多问题，目前感觉大部分已经自己解决掉了。只差最后一部分，即：通过字典得到的符合筛选条件的item值无法提取到单元格中。想了2天，始终不能解决，所以来向各位高手求助啦。请不吝赐教！感谢感谢！！！（我写的代码太长，无法贴出来，详见附件，请见谅！）

最佳答案

月排行榜 / 总排行榜

grf1973

2016-11-8 11:19

1. Sub t1()
   
2.     Dim arr, i, j, k, dJG, dXL
   
3.     Set dJG = CreateObject("scripting.dictionary")     '价格
   
4.     Set dXL = CreateObject("scripting.dictionary")    '销量
   
5.    
   
6.     arr = Sheets(1).[a1].CurrentRegion    '价格
   
7.     For i = 3 To UBound(arr)
   
8.         For j = 2 To UBound(arr, 2)
   
9.             xkey = arr(i, 1) & arr(2, j) '以产品名+日期为key
   
10.             dJG(xkey) = arr(i, j)       '以价格为item
    
11.         Next
    
12.     Next
    
13.    
    
14.     For k = 2 To 4   '销量
    
15.         arr = Sheets(k).[a1].CurrentRegion
    
16.         For i = 2 To UBound(arr)
    
17.             xkey = arr(i, 2) & arr(i, 1) '以产品名+日期为key
    
18.             dXL(xkey) = dXL(xkey) + arr(i, 3)       '以销量之和为item
    
19.         Next
    
20.     Next
    
21.    
    
22.     With Sheets(5)    '汇总
    
23.         arr = .[a1].CurrentRegion
    
24.         For i = 3 To UBound(arr)
    
25.             For j = 2 To UBound(arr, 2)
    
26.                 xkey = arr(i, 1) & arr(2, j) '以产品名+日期为key
    
27.                 arr(i, j) = dJG(xkey) * dXL(xkey)  '以价格*销量为输出结果
    
28.             Next
    
29.         Next
    
30.         .[a1].CurrentRegion = arr      '输出结果
    
31.         .Activate
    
32.     End With
    
33. End Sub
    

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, d, d2, i&, j%
   
3. Set d = CreateObject("scripting.dictionary") '数量
   
4. Set d2 = CreateObject("scripting.dictionary") '当日价格
   
5. Sheets("目标表格").Activate
   
6. brr = [a2:af16]
   
7. arr = Sheet1.Range("a2").CurrentRegion
   
8. For i = 3 To UBound(arr)
   
9.     For j = 2 To UBound(arr, 2)
   
10.         zf = arr(i, 1) & "," & arr(2, j)
    
11.         d2(zf) = arr(i, j)
    
12.     Next
    
13. Next
    
14. For j = 2 To 4
    
15.     arr = Sheets(j).Range("a1").CurrentRegion
    
16.     For i = 2 To UBound(arr)
    
17.         zf = arr(i, 2) & "," & arr(i, 1)
    
18.         d(zf) = d(zf) + arr(i, 3)
    
19.     Next
    
20. Next
    
21. For i = 2 To UBound(brr)
    
22.     For j = 2 To UBound(brr, 2)
    
23.         zf = brr(i, 1) & "," & brr(1, j)
    
24.         brr(i, j) = d(zf) * d2(zf)
    
25.     Next
    
26. Next
    
27. [a2:af16] = brr
    
28. End Sub

复制代码

grf1973

1. Sub t1()
   
2.     Dim arr, i, j, k, dJG, dXL
   
3.     Set dJG = CreateObject("scripting.dictionary")     '价格
   
4.     Set dXL = CreateObject("scripting.dictionary")    '销量
   
5.    
   
6.     arr = Sheets(1).[a1].CurrentRegion    '价格
   
7.     For i = 3 To UBound(arr)
   
8.         For j = 2 To UBound(arr, 2)
   
9.             xkey = arr(i, 1) & arr(2, j) '以产品名+日期为key
   
10.             dJG(xkey) = arr(i, j)       '以价格为item
    
11.         Next
    
12.     Next
    
13.    
    
14.     For k = 2 To 4   '销量
    
15.         arr = Sheets(k).[a1].CurrentRegion
    
16.         For i = 2 To UBound(arr)
    
17.             xkey = arr(i, 2) & arr(i, 1) '以产品名+日期为key
    
18.             dXL(xkey) = dXL(xkey) + arr(i, 3)       '以销量之和为item
    
19.         Next
    
20.     Next
    
21.    
    
22.     With Sheets(5)    '汇总
    
23.         arr = .[a1].CurrentRegion
    
24.         For i = 3 To UBound(arr)
    
25.             For j = 2 To UBound(arr, 2)
    
26.                 xkey = arr(i, 1) & arr(2, j) '以产品名+日期为key
    
27.                 arr(i, j) = dJG(xkey) * dXL(xkey)  '以价格*销量为输出结果
    
28.             Next
    
29.         Next
    
30.         .[a1].CurrentRegion = arr      '输出结果
    
31.         .Activate
    
32.     End With
    
33. End Sub
    

复制代码

淺喝情歌

，谢谢2位老师的精彩解答，程序都可以完美运行的，只是grf1973老师的解答附带了更多的注释，更方便我这小白级别的理解，故此设为最佳啦。再次感谢两位老师的热心帮助！！祝生活如意顺遂！