请问如何用程序代替公式以便提高速度？

huagnzhailing

大家好，
我的这个表有很多公式，数据量大时运行非常慢，不知能不能用程序来代代替公式？ 物料表.rar (22.01 KB, 下载次数: 49)

2012-6-23 12:14 上传

点击文件名下载附件

非常感谢大家

香川群子

建议使用数据库。

不应该使用Excel

doitbest

1. Public Sub sumif1()
   
2. Dim ar, br(), i, cr, dr, er
   
3. Dim d1 As Object, d2 As Object, d3 As Object, d4 As Object, d5 As Object
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. Set d2 = CreateObject("Scripting.Dictionary")
   
6. Set d3 = CreateObject("Scripting.Dictionary")
   
7. Set d4 = CreateObject("Scripting.Dictionary")
   
8. Set d5 = CreateObject("Scripting.Dictionary")
   
9. ar = Range([b6], [b6].End(4))
   
10. ReDim br(1 To UBound(ar), 1 To 5)
    
11. cr = Sheets("数据库．在途量").Range("e4:j" & Sheets("数据库．在途量").[j65536].End(3).Row)
    
12. dr = Sheets("数据库．IQC在检").Range("a4:c" & Sheets("数据库．IQC在检").[c65536].End(3).Row)
    
13. er = Sheets("数据库.森田总表").Range("c4:s" & Sheets("数据库.森田总表").[s65536].End(3).Row)
    
14. For i = 1 To UBound(cr)
    
15.     If Not d1.exists(cr(i, 1)) Then
    
16.         d1(cr(i, 1)) = cr(i, 6)
    
17.     Else
    
18.         d1(cr(i, 1)) = d1(cr(i, 1)) + cr(i, 6)
    
19.     End If
    
20. Next
    
21. For i = 1 To UBound(dr)
    
22.     d2(dr(i, 1)) = dr(i, 3)
    
23. Next
    
24. For i = 1 To UBound(er)
    
25.     If Not d3.exists(er(i, 1)) Then d3(er(i, 1)) = er(i, 12)
    
26.     If Not d4.exists(er(i, 1)) Then d4(er(i, 1)) = er(i, 17)
    
27.     If Not d5.exists(er(i, 1)) Then d5(er(i, 1)) = er(i, 14)
    
28. Next
    
29. For i = 1 To UBound(ar)
    
30.     If Not d1.exists(ar(i, 1)) Then
    
31.         br(i, 1) = 0
    
32.     Else
    
33.         br(i, 1) = d1(ar(i, 1))
    
34.     End If
    
35.     If d2.exists(ar(i, 1)) Then br(i, 2) = d2(ar(i, 1)) Else br(i, 2) = 0
    
36.     If d3.exists(ar(i, 1)) Then br(i, 3) = d3(ar(i, 1)) Else br(i, 3) = 0
    
37.     If d4.exists(ar(i, 1)) Then br(i, 4) = d4(ar(i, 1))
    
38.     If d5.exists(ar(i, 1)) Then br(i, 5) = d5(ar(i, 1))
    
39. Next
    
40. [j6].Resize(UBound(ar), 5) = br
    
41. Set d1 = Nothing
    
42. Set d2 = Nothing
    
43. Set d3 = Nothing
    
44. Set d4 = Nothing
    
45. Set d5 = Nothing
    
46. End Sub

复制代码

doitbest

请参考附件

zhaogang1960

doitbest 发表于 2012-6-23 16:59
请参考附件

探讨一下：使用一个字典速度是否会快些？

1. Sub Macro1()
   
2.     Dim ar, br(), i&, j&, cr, dr, er
   
3.     Dim d As Object
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     ar = Range([b6], [b6].End(4))
   
6.     ReDim br(1 To UBound(ar), 1 To 5)
   
7.     cr = Sheets("数据库．在途量").Range("e4:j" & Sheets("数据库．在途量").[j65536].End(3).Row)
   
8.     dr = Sheets("数据库．IQC在检").Range("a4:c" & Sheets("数据库．IQC在检").[c65536].End(3).Row)
   
9.     er = Sheets("数据库.森田总表").Range("c4:s" & Sheets("数据库.森田总表").[s65536].End(3).Row)
   
10.     For i = 1 To UBound(cr)
    
11.         d(1 & Chr(9) & cr(i, 1)) = d(1 & Chr(9) & cr(i, 1)) + cr(i, 6)
    
12.     Next
    
13.     For i = 1 To UBound(dr)
    
14.         d(2 & Chr(9) & dr(i, 1)) = dr(i, 3)
    
15.     Next
    
16.     For i = 1 To UBound(er)
    
17.         If Not d.exists(3 & Chr(9) & er(i, 1)) Then d(3 & Chr(9) & er(i, 1)) = er(i, 12)
    
18.         If Not d.exists(4 & Chr(9) & er(i, 1)) Then d(4 & Chr(9) & er(i, 1)) = er(i, 17)
    
19.         If Not d.exists(5 & Chr(9) & er(i, 1)) Then d(5 & Chr(9) & er(i, 1)) = er(i, 14)
    
20.     Next
    
21.     For i = 1 To UBound(ar)
    
22.         For j = 1 To 3
    
23.             If d.exists(j & Chr(9) & ar(i, 1)) Then br(i, j) = d(j & Chr(9) & ar(i, 1)) Else br(i, j) = 0
    
24.         Next
    
25.         For j = 4 To 5
    
26.             br(i, j) = d(j & Chr(9) & ar(i, 1))
    
27.         Next
    
28.     Next
    
29.     [j6].Resize(UBound(ar), 5) = br
    
30. End Sub
    

复制代码

物料表.rar (25.18 KB, 下载次数: 49)

2012-6-23 18:58 上传

点击文件名下载附件

huagnzhailing

香川群子 发表于 2012-6-23 14:35
建议使用数据库。

不应该使用Excel

香川群子老师，是这样的，我们公司有上ERP系统，只是这个EPR系统总有这样或那样不尽人意的地方．
所以，很多同事都会从EPR导出库存总表等资料，然后用EXCEL进行编辑管理．我的所谓数据库，其实就是从ERP导出的资料而已．而ERP导出的数据动则好几万行，想用公式进行一些编辑，速度就相当慢了．

huagnzhailing

zhaogang1960 发表于 2012-6-23 18:59
探讨一下：使用一个字典速度是否会快些？

赵老师您好，我对您的印象太深了，两年前您帮我写的一些程序对我工作上的帮忙影响非常深远．只是我现在重新注册了用户．再次对您说声感谢．

如果用一个字典能更快一些就太好了．只是我现在不在办公室，没法导出EPR数据，我想只有在数据量超大的情况下才好看出一个字典和多个字典的速度差别．还有我刚才运行了一下，怎么E列的＂单位＂数据提取不出来？

另，附件的 F列数据的提取，其程序也是"doitbest" 在我的一篇名为＂请问如何从数据库中提取指定仓库的库存？＂中写的，给我的帮助也相当大．G列，H列，I列的数据提取，是我复制　doitbest老师的程序而得．总感觉这样复制就很累赘了，数据量大时感觉还是有点慢．不知还能不能优化？ 物料1.rar (21.9 KB, 下载次数: 15)

2012-6-23 22:05 上传

点击文件名下载附件

最后，如何把刚才的＂一个字典＂程序，和上述程序连在一起？

非常感谢

zhaogang1960

huagnzhailing 发表于 2012-6-23 21:56
赵老师您好，我对您的印象太深了，两年前您帮我写的一些程序对我工作上的帮忙影响非常深远．只是我现在 ...

和原来程序衔接请doitbest老师完成吧，我看不懂别人写的代码
关于E列的＂单位＂：

1. Sub Macro1()
   
2.     Dim ar, br(), i&, j&, cr, dr, er
   
3.     Dim d As Object
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     ar = Range([b6], [b6].End(4))
   
6.     ReDim br(1 To UBound(ar), 1 To 5)
   
7.     cr = Sheets("数据库．在途量").Range("e4:j" & Sheets("数据库．在途量").[j65536].End(3).Row)
   
8.     dr = Sheets("数据库．IQC在检").Range("a4:c" & Sheets("数据库．IQC在检").[c65536].End(3).Row)
   
9.     er = Sheets("数据库.森田总表").Range("c4:s" & Sheets("数据库.森田总表").[s65536].End(3).Row)
   
10.     For i = 1 To UBound(cr)
    
11.         d(1 & Chr(9) & cr(i, 1)) = d(1 & Chr(9) & cr(i, 1)) + cr(i, 6)
    
12.     Next
    
13.     For i = 1 To UBound(dr)
    
14.         d(2 & Chr(9) & dr(i, 1)) = dr(i, 3)
    
15.     Next
    
16.     For i = 1 To UBound(er)
    
17.         If Not d.exists(3 & Chr(9) & er(i, 1)) Then d(3 & Chr(9) & er(i, 1)) = er(i, 12)
    
18.         If Not d.exists(4 & Chr(9) & er(i, 1)) Then d(4 & Chr(9) & er(i, 1)) = er(i, 17)
    
19.         If Not d.exists(5 & Chr(9) & er(i, 1)) Then d(5 & Chr(9) & er(i, 1)) = er(i, 14)
    
20.         d(6 & Chr(9) & er(i, 1)) = er(i, 5)
    
21.     Next
    
22.     For i = 1 To UBound(ar)
    
23.         For j = 1 To 3
    
24.             If d.exists(j & Chr(9) & ar(i, 1)) Then br(i, j) = d(j & Chr(9) & ar(i, 1)) Else br(i, j) = 0
    
25.         Next
    
26.         For j = 4 To 5
    
27.             br(i, j) = d(j & Chr(9) & ar(i, 1))
    
28.         Next
    
29.         ar(i, 1) = d(6 & Chr(9) & ar(i, 1))
    
30.     Next
    
31.     [j6].Resize(i - 1, 5) = br
    
32.     [e6].Resize(i - 1) = ar
    
33. End Sub
    
34. 
    

复制代码

doitbest

谢谢老师鼓励！！对两个代码进行了测试，结果相差无几。用6万条数据测试，3楼用时3.141秒，5楼用时3.156秒，二者速度差别基本忽略不计，但5楼代码在思路和简洁性上更有优势

zhaogang1960

doitbest 发表于 2012-6-24 08:21
谢谢老师鼓励！！对两个代码进行了测试，结果相差无几。用6万条数据测试，3楼用时3.141秒，5楼用时3.156秒， ...

谢谢测试，如果速度没有提高就没有实际意义
请楼主用大数据测试下面两个程序：

1. 
   
2. Public Sub sumif1() '6个字典
   
3.     Dim ar, br(), i, cr, dr, er, tt
   
4.     tt = Timer
   
5.     Dim d1 As Object, d2 As Object, d3 As Object, d4 As Object, d5 As Object, d6 As Object
   
6.     Set d1 = CreateObject("Scripting.Dictionary")
   
7.     Set d2 = CreateObject("Scripting.Dictionary")
   
8.     Set d3 = CreateObject("Scripting.Dictionary")
   
9.     Set d4 = CreateObject("Scripting.Dictionary")
   
10.     Set d5 = CreateObject("Scripting.Dictionary")
    
11.     Set d6 = CreateObject("Scripting.Dictionary")
    
12.     ar = Range([b6], [b6].End(4))
    
13.     ReDim br(1 To UBound(ar), 1 To 5)
    
14.     cr = Sheets("数据库．在途量").Range("e4:j" & Sheets("数据库．在途量").[j65536].End(3).Row)
    
15.     dr = Sheets("数据库．IQC在检").Range("a4:c" & Sheets("数据库．IQC在检").[c65536].End(3).Row)
    
16.     er = Sheets("数据库.森田总表").Range("c4:s" & Sheets("数据库.森田总表").[s65536].End(3).Row)
    
17.     For i = 1 To UBound(cr)
    
18.         If Not d1.exists(cr(i, 1)) Then
    
19.             d1(cr(i, 1)) = cr(i, 6)
    
20.         Else
    
21.             d1(cr(i, 1)) = d1(cr(i, 1)) + cr(i, 6)
    
22.         End If
    
23.     Next
    
24.     For i = 1 To UBound(dr)
    
25.         d2(dr(i, 1)) = dr(i, 3)
    
26.     Next
    
27.     For i = 1 To UBound(er)
    
28.         If Not d3.exists(er(i, 1)) Then d3(er(i, 1)) = er(i, 12)
    
29.         If Not d4.exists(er(i, 1)) Then d4(er(i, 1)) = er(i, 17)
    
30.         If Not d5.exists(er(i, 1)) Then d5(er(i, 1)) = er(i, 14)
    
31.         d6(er(i, 1)) = er(i, 5)
    
32.     Next
    
33.     For i = 1 To UBound(ar)
    
34.         If Not d1.exists(ar(i, 1)) Then
    
35.             br(i, 1) = 0
    
36.         Else
    
37.             br(i, 1) = d1(ar(i, 1))
    
38.         End If
    
39.         If d2.exists(ar(i, 1)) Then br(i, 2) = d2(ar(i, 1)) Else br(i, 2) = 0
    
40.         If d3.exists(ar(i, 1)) Then br(i, 3) = d3(ar(i, 1)) Else br(i, 3) = 0
    
41.         If d4.exists(ar(i, 1)) Then br(i, 4) = d4(ar(i, 1))
    
42.         If d5.exists(ar(i, 1)) Then br(i, 5) = d5(ar(i, 1))
    
43.         ar(i, 1) = d6(ar(i, 1))
    
44.     Next
    
45.     [j6].Resize(UBound(ar), 5) = br
    
46.     [e6].Resize(i - 1) = ar
    
47.     Set d1 = Nothing
    
48.     Set d2 = Nothing
    
49.     Set d3 = Nothing
    
50.     Set d4 = Nothing
    
51.     Set d5 = Nothing
    
52.     MsgBox Timer - tt
    
53. End Sub
    

复制代码

1. 
   
2. Sub Macro1() '1个字典
   
3.     Dim ar, br(), i&, j&, cr, dr, er, tt
   
4.     tt = Timer
   
5.     Dim d As Object
   
6.     Set d = CreateObject("Scripting.Dictionary")
   
7.     ar = Range([b6], [b6].End(4))
   
8.     ReDim br(1 To UBound(ar), 1 To 5)
   
9.     cr = Sheets("数据库．在途量").Range("e4:j" & Sheets("数据库．在途量").[j65536].End(3).Row)
   
10.     dr = Sheets("数据库．IQC在检").Range("a4:c" & Sheets("数据库．IQC在检").[c65536].End(3).Row)
    
11.     er = Sheets("数据库.森田总表").Range("c4:s" & Sheets("数据库.森田总表").[s65536].End(3).Row)
    
12.     For i = 1 To UBound(cr)
    
13.         d(cr(i, 1)) = d(cr(i, 1)) + cr(i, 6)
    
14.     Next
    
15.     For i = 1 To UBound(dr)
    
16.         d("A" & dr(i, 1)) = dr(i, 3)
    
17.     Next
    
18.     For i = 1 To UBound(er)
    
19.         If Not d.exists("B" & er(i, 1)) Then d("B" & er(i, 1)) = er(i, 12)
    
20.         If Not d.exists("C" & er(i, 1)) Then d("C" & er(i, 1)) = er(i, 17)
    
21.         If Not d.exists("D" & er(i, 1)) Then d("D" & er(i, 1)) = er(i, 14)
    
22.         d("E" & er(i, 1)) = er(i, 5)
    
23.     Next
    
24.     For i = 1 To UBound(ar)
    
25.         If d.exists(ar(i, 1)) Then br(i, 1) = d(ar(i, 1)) Else br(i, 1) = 0
    
26.         If d.exists("A" & ar(i, 1)) Then br(i, 2) = d("A" & ar(i, 1)) Else br(i, 2) = 0
    
27.         If d.exists("B" & ar(i, 1)) Then br(i, 3) = d("B" & ar(i, 1)) Else br(i, 3) = 0
    
28.         br(i, 4) = d("C" & ar(i, 1))
    
29.         br(i, 5) = d("D" & ar(i, 1))
    
30.         ar(i, 1) = d("E" & ar(i, 1))
    
31.     Next
    
32.     [j6].Resize(i - 1, 5) = br
    
33.     [e6].Resize(i - 1) = ar
    
34.     MsgBox Timer - tt
    
35. End Sub
    

复制代码