[分享]50万数据海量字典&数组查询总结

Zamyi

50万数据海量字典&数组查询总结(EXCEL2007)（已解决）：

感谢狼主及zldccmx的热心帮助！

beeyOcyp.rar (27.93 KB, 下载次数: 760)

2008-10-15 10:43 上传

点击文件名下载附件
[分享]50万数据海量字典&数组查询总结

[此贴子已经被作者于2008-10-15 10:49:33编辑过]

Zamyi

没有帮？

Sub 查已用()
Dim x, y, i, zR, yR
Dim d As Object
t1 = Timer
Application.ScreenUpdating = False
x = Range("b1048576").End(xlUp).Row
y = Range("c1048576").End(xlUp).Row
zR = Range("a1:c" & x)
Set d = CreateObject("scripting.dictionary")
For i = 1 To x
  If Not d.Exists(zR(i, 2)) Then d.Add zR(i, 2), zR(i, 1)
  Next i
t2 = Timer - t1
For i = 1 To y
  If d.Exists(zR(i, 3)) Then d.Remove zR(i, 3)
  Next i
  t3 = Timer - t1
yR = d.keys
ym = d.items
For i = 1 To d.Count
  Cells(i, 5) = yR(i - 1)
Next i
Set d = Nothing
Application.ScreenUpdating = True
t4 = Timer - t1
Cells(1, 7) = t2
Cells(2, 7) = t3
Cells(3, 7) = t4
End Sub

laosanjie

QUOTE:

以下是引用Zamyi在2008-10-11 23:04:00的发言：

B列数据包含C列数据,要求把B列数据去除C列数据后存放于E列,实际数据B列有20多万个,后面是我写的代码,速度太慢,问题最大的是数组太大不能赋值给单元格.请求达者给予代码优化,先谢过!

“实际数据B列有20多万个”！楼主用的是2007版的！[em09]

Zamyi

是的

northwolves

Try：

Sub 查已用()
Dim x&, y&, i&, n&, d As Object, zr, t1 As Single
t1 = Timer
x = Range("b1048576").End(xlUp).Row
y = Range("c1048576").End(xlUp).Row
zr = Range("b1:d" & x)
Set d = CreateObject("scripting.dictionary")

For i = 1 To y
d(zr(i, 2)) = ""
Next

For i = 1 To x
If Not d.exists(zr(i, 1)) Then n = n + 1: zr(n, 3) = zr(i, 1)
Next
[d1].Resize(n) = Application.Index(zr, 0, 3)
Set d = Nothing
MsgBox Format(Timer - t, "0.000") & " Seconds!"

End Sub

Zamyi

好一个Application.Index(zr, 0, 3)，不过，当数据量大时，运行出错，提示数据类型不相符，这跟数组赋值给单元格有点相似。

Zamyi

天大的发现，就是对于不同的数据源格式zR(i, 3)，如文本和整数，在d(zR(i, 3))=""这里的运行速度相差惊人，整数的比文本的要慢80倍！我原来的数目BC列各20多万，如果用整数要用掉大量的时间。代码修改如下：才27秒多就完成：

Sub 查已用4()
Dim x, y, i, zR, yR
Dim d As Object
t1 = Timer
Application.ScreenUpdating = False
x = Range("b1048576").End(xlUp).Row
y = Range("c1048576").End(xlUp).Row
zR = Range("a1:d" & x)
For i = 1 To x
  zR(i, 2) = "S" & zR(i, 2)
  If Not zR(i, 3) = "" Then zR(i, 3) = "S" & zR(i, 3)
Next i
Set d = CreateObject("scripting.dictionary")
For i = 1 To y
d(zR(i, 3)) = ""
Next
For i = 1 To x
If Not d.exists(zR(i, 2)) Then n = n + 1: zR(n, 4) = zR(i, 2)
Next
For i = 1 To n
  zR(i, 4) = Right(zR(i, 4), Len(zR(i, 4)) - 1)
Next i
For i = 1 To n
  Range("D" & i) = zR(i, 4)
Next i
'[d1].Resize(n) = Application.Index(zR, 0, 4) '这句在数量大的时候通不过
Set d = Nothing
Application.ScreenUpdating = True
Cells(1, 7) = Timer - t1
End Sub
遗憾的是[d1].Resize(n) = Application.Index(zR, 0, 4)这句在数量大的时候通不过。

northwolves

这样应该快些：

Sub 查已用()

Dim x&, y&, i&, n&, d As Object, zR, dR, t1 As Single
t1 = Timer
x = Range("b1048576").End(xlUp).Row
y = Range("c1048576").End(xlUp).Row
zR = [b1].Resize(x, 2)
dR = [d1].Resize(x)
Set d = CreateObject("scripting.dictionary")

For i = 1 To y
d("s" & zR(i, 2)) = ""
Next

For i = 1 To x
If Not d.exists("s" & zR(i, 1)) Then n = n + 1: dR(n, 1) = zR(i, 1)
Next

[d1].Resize(n) = dR
Set d = Nothing
MsgBox Format(Timer - t, "0.000") & " Seconds!"

End Sub

zldccmx

QUOTE:

以下是引用Zamyi在2008-10-13 14:58:00的发言：

天大的发现，就是对于不同的数据源格式zR(i, 3)，如文本和整数，在d(zR(i, 3))=""这里的运行速度相差惊人，整数的比文本的要慢80倍！

呵呵，实际应用中，老朽之前一直是这样处理的：

For I =1  to 10 :DIC("" & i) = "" :NEXT

这样处理可能不仅是时间的问题，更是结果是否正确的问题!  时间消耗老朽没有考证，但是返回结果这方面老朽是有验证的!

为了不改变输出结果且保证结果准确，所以就对数值型变量进行转换，使之成为字符串

原涛松木

版主能上传个03版面的吗？