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

huagnzhailing · 发表于 2012-6-26 22:02

zhaogang1960 发表于 2012-6-24 11:15
谢谢测试，如果速度没有提高就没有实际意义
请楼主用大数据测试下面两个程序：

ZHAO老师，今天下午我在办公室测试的数据如下：
当＂数据库．森田总表＂为60000行，＂物料＂为20行时：一个字典用时13.90625,　6个字典不祥，运行时间太久，终止运行了

当＂数据库．森田总表＂为60000行，＂物料＂为10000行时：一个字典用时19.0625,　6个字典不祥，运行时间太久，终止运行了

当＂数据库．森田总表＂为60000行，＂物料＂为50000行时：一个字典用时34.2171,　6个字典不祥，未测试

当＂物料＂表为20行，＂数据库，森田总表＂为10000行时，6个字典用时7.9375,一个字典没测试
当＂物料＂表为10000行，＂数据库，森田总表＂为20行时，6个字典用时2.59375,一个字典没测试

zhaogang1960 · 发表于 2012-6-26 22:32

huagnzhailing 发表于 2012-6-26 22:02
ZHAO老师，今天下午我在办公室测试的数据如下：
当＂数据库．森田总表＂为60000行，＂物料＂为20行时：一 ...

测试结果说明，就大数据而言，字典使用越多速度越慢，所以能少用就尽量少用

huagnzhailing · 发表于 2012-6-27 19:17

本帖最后由 huagnzhailing 于 2012-6-27 19:18 编辑

zhaogang1960 发表于 2012-6-26 22:32
测试结果说明，就大数据而言，字典使用越多速度越慢，所以能少用就尽量少用

ZHAO老师，经过测试我感觉主要还是数据库的数据是太大了，运行才比较慢，如果能有什么程序，点一下按钮，就能删除不想要的数据就好了．具体要求在附件内的＂数据库．森田总表＂里了，我只会写一些删除空格所在的行这样程序，复杂点的就要再学习了．

另，测试中，我发现程序貌似有点漏洞，具体我写在附件中的＂物料＂工作表内了

字典测试.rar (20.3 KB, 下载次数: 11)

zhaogang1960 · 发表于 2012-6-27 19:41

Sub Macro1() '1个字典
Dim ar, br(), i&, j&, cr, dr, er, tt
tt = Timer
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")
' ar = Range([b6], [b6].End(4))
ar = Range([b1], [b65536].End(3))
ReDim br(1 To UBound(ar), 1 To 5)
cr = Sheets("数据库．在途量").Range("e4:j" & Sheets("数据库．在途量").[j65536].End(3).Row)
dr = Sheets("数据库．IQC在检").Range("a4:c" & Sheets("数据库．IQC在检").[c65536].End(3).Row)
er = Sheets("数据库.森田总表").Range("c4:s" & Sheets("数据库.森田总表").[s65536].End(3).Row)
For i = 6 To UBound(cr)
d(cr(i, 1)) = d(cr(i, 1)) + cr(i, 6)
Next
For i = 1 To UBound(dr)
d("A" & dr(i, 1)) = dr(i, 3)
Next
For i = 1 To UBound(er)
If Not d.exists("B" & er(i, 1)) Then d("B" & er(i, 1)) = er(i, 12)
If Not d.exists("C" & er(i, 1)) Then d("C" & er(i, 1)) = er(i, 17)
If Not d.exists("D" & er(i, 1)) Then d("D" & er(i, 1)) = er(i, 14)
d("E" & er(i, 1)) = er(i, 5)
Next
For j = 6 To UBound(ar)
i = j - 5
If d.exists(ar(i, 1)) Then br(i, 1) = d(ar(i, 1)) Else br(i, 1) = 0
If d.exists("A" & ar(i, 1)) Then br(i, 2) = d("A" & ar(i, 1)) Else br(i, 2) = 0
If d.exists("B" & ar(i, 1)) Then br(i, 3) = d("B" & ar(i, 1)) Else br(i, 3) = 0
br(i, 4) = d("C" & ar(i, 1))
br(i, 5) = d("D" & ar(i, 1))
ar(i, 1) = d("E" & ar(i, 1))
Next
Range("E6:E65536,J6:j65536").ClearContents
[j6].Resize(i, 5) = br
If i > 1 Then [e6].Resize(i - 1) = ar Else [e6] = ar(1, 1)
MsgBox Timer - tt
End Sub

复制代码

zhaogang1960 · 发表于 2012-6-27 19:41

请看附件

字典测试.rar (20.9 KB, 下载次数: 35)

huagnzhailing · 发表于 2012-6-27 21:02

zhaogang1960 发表于 2012-6-27 19:41
请看附件

测试了一下，当B6单元格为空时，提取结果出现错误

huagnzhailing · 发表于 2012-6-27 21:05

本帖最后由 huagnzhailing 于 2012-6-27 21:06 编辑

zhaogang1960 发表于 2012-6-27 19:41
请看附件

还想请教老师一个问题，为什么出现　MsgBox Timer - tt　对话框以后，光标一直处于等待状态？

zhaogang1960 · 发表于 2012-6-27 21:19

字典测试.rar (18.58 KB, 下载次数: 15)

huagnzhailing · 发表于 2012-6-27 21:27

zhaogang1960 发表于 2012-6-27 21:19

还是有点小问题，当B6单元格输入＂1＂进行测试，提取结果出现错误

zhaogang1960 · 发表于 2012-6-27 22:18

huagnzhailing 发表于 2012-6-27 21:27
还是有点小问题，当B6单元格输入＂1＂进行测试，提取结果出现错误

字典测试.rar (19.42 KB, 下载次数: 40)

		自动登录	找回密码
密码			免费注册

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