哪位大神帮忙看看 vba字典问题

244506982

如题,内容在图片

chaohuahch

你的表格里面，还有那么多的代码。你想让看那个？而且你的with语句内，很多单元格的应用，都没有加.的运算符，你结算的结果都不一定正确。

jiminyanyan

http://club.excelhome.net/thread-868892-1-1.html

244506982

chaohuahch 发表于 2018-7-20 21:06
你的表格里面，还有那么多的代码。你想让看那个？而且你的with语句内，很多单元格的应用，都没有加.的运算 ...

其实我也不懂这个，我在这个论坛下载的，然后改一些数字就用到这个表上面了，sheet里的代码是相当vlookup的，就不用理会，模块里有三个sub，一个是对应入库，一个是对应退货，一个是对应出库的，我记得有在旁边注释了一下的。

我想实现的就是sumif函数用代码实现而已。麻烦你帮我看看。

chaohuahch

算是简化了一下代码把。

1. Sub test()
   
2. Dim arr, brr, crr, drr
   
3. 'arr为入库数据，brr为退货数据，crr为出库数据，drr为商品信息目录数据
   
4. Dim i%, dic, dic1, dic2
   
5. Set dic = CreateObject("scripting.dictionary")
   
6. Set dic1 = CreateObject("scripting.dictionary")
   
7. Set dic2 = CreateObject("scripting.dictionary")
   
8. arr = Sheets("入库").Range("a1").CurrentRegion
   
9. brr = Sheets("退货").Range("a1").CurrentRegion
   
10. crr = Sheets("出库").Range("a1").CurrentRegion
    
11. drr = Sheets("商品信息目录").Range("a1").CurrentRegion
    
12. 
    
13. For i = 2 To UBound(arr, 1)
    
14.   dic(arr(i, 2)) = dic(arr(i, 2)) + arr(i, 5)
    
15. Next i
    
16. For i = 2 To UBound(brr, 1)
    
17.   dic1(brr(i, 2)) = dic1(brr(i, 2)) + brr(i, 3)
    
18. Next i
    
19. For i = 2 To UBound(crr, 1)
    
20.   dic2(brr(i, 2)) = dic2(crr(i, 2)) + crr(i, 3)
    
21. Next i
    
22. 
    
23. For i = 2 To UBound(drr, 1)
    
24.   If dic.exists(drr(i, 3)) Then drr(i, 8) = dic(drr(i, 3))
    
25.   If dic1.exists(drr(i, 3)) Then drr(i, 9) = dic1(drr(i, 3))
    
26.   If dic2.exists(drr(i, 3)) Then drr(i, 10) = dic2(drr(i, 3))
    
27.   drr(i, 11) = drr(i, 7) + drr(i, 8) + drr(i, 9) - drr(i, 10)
    
28. Next i
    
29. Sheets("商品信息目录").Range("a1").Resize(UBound(drr), UBound(drr, 2)) = drr
    
30.   
    
31.   
    
32. End Sub

复制代码

244506982

chaohuahch 发表于 2018-7-20 23:08
算是简化了一下代码把。

谢谢，不知道期末那①列你有没有帮我弄好。我看到那一列没有动。

244506982

chaohuahch 发表于 2018-7-20 23:08
算是简化了一下代码把。

不好意思，刚才看到代码里有这个计算了，回去上班时再看看。tks

lsc900707

1. Sub gj23w98()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Set e = CreateObject("scripting.dictionary")
   
4.     Set f = CreateObject("scripting.dictionary")
   
5.     brr = Sheet4.[a1].CurrentRegion
   
6.     For i = 2 To UBound(brr)
   
7.         d(brr(i, 2)) = d(brr(i, 2)) + brr(i, 5)
   
8.     Next
   
9.     crr = Sheet6.[a1].CurrentRegion
   
10.     For i = 2 To UBound(crr)
    
11.         e(crr(i, 2)) = e(crr(i, 2)) + crr(i, 3)
    
12.     Next
    
13.     drr = Sheet5.[a1].CurrentRegion
    
14.     For i = 2 To UBound(drr)
    
15.         f(drr(i, 2)) = f(drr(i, 2)) + drr(i, 3)
    
16.     Next
    
17.     arr = [a1].CurrentRegion
    
18.     For i = 2 To UBound(arr)
    
19.         arr(i, 8) = d(arr(i, 3))
    
20.         arr(i, 9) = f(arr(i, 3))
    
21.         arr(i, 10) = e(arr(i, 3))
    
22.         arr(i, 11) = arr(i, 7) + arr(i, 8) - arr(i, 10)+ arr(i, 9)
    
23.     Next
    
24.     [a1].CurrentRegion = arr
    
25. End Sub

复制代码

lsc900707

附件供参考测试：

244506982

lsc900707 发表于 2018-7-21 08:06
附件供参考测试：

arr(i, 11) = arr(i, 7) + arr(i, 8) - arr(i, 10)+ arr(i, 9)   这句提示类型 不匹配.