|
发表于 2014-1-22 14:23
|
显示全部楼层
本楼为最佳答案
对关键词拆分成二部分以后进行字典嵌套处理的算法:
字典处理部分时间略有增加,(要分二段进行处理)
但后面比对处理时速度更快了。(比对数据中前半部分不符合项越多速度越快)- Sub test3()
- Dim i&, k&, l&, s$, s1$, s2$
- tms = Timer
- 'l = 0 '此参数为拆分参数,设置l=0时就相当于通常只使用1个字典的用法。
- l = 3 ' 通常设置l=3 或l=4较好。
- ' 但如设置l很大本例设置l=8时使得第一字典项很多就毫无效果了,反而速度更慢会死机
-
- arr = Sheet1.Range("a1").CurrentRegion
- Set d = CreateObject("Scripting.Dictionary")
- For i = 1 To UBound(arr)
- s = arr(i, 1): s1 = Left(s, l): s2 = Mid(s, l + 1)
- If Not d.Exists(s1) Then Set d(s1) = CreateObject("Scripting.Dictionary")
- d(s1)(s2) = ""
- Next
- krr = d.keys
- For i = 1 To d.Count
- k = k + d(krr(i - 1)).Count
- Next
- MsgBox Format(Timer - tms, "0.000s ") & d.Count & vbCr & k: tms = Timer
- m = Sheet2.Range("a1").End(4).Row
- arr = Sheet2.Range("a1").Resize(m)
- For i = 1 To m
- s = arr(i, 1): s1 = Left(s, l): s2 = Mid(s, l + 1)
- If Not d.Exists(s1) Then arr(i, 1) = "无" Else If d(s1).Exists(s2) Then arr(i, 1) = "有" Else arr(i, 1) = "无"
- '上面是简写,下面是正规的If结构
- ' If d.Exists(s1) Then
- ' If d(s1).Exists(s2) Then
- ' arr(i, 1) = "有"
- ' Else
- ' arr(i, 1) = "无"
- ' End If
- ' Else
- ' arr(i, 1) = "无"
- ' End If
- Next
- MsgBox Format(Timer - tms, "0.000s ") & m
-
- ' Sheet2.Range("d1").Resize(m) = arr '输出到工作表
- End Sub
复制代码 爱疯你自己比较一下吧。
|
评分
-
查看全部评分
|