用VBA字典提速这个速度太慢

laoau138

用VBA字典提速这个速度太慢

grf1973

1. Sub 提速()   'by grf
   
2.     Dim SArr1, SArr, Flag As Boolean, t
   
3.     t = Timer
   
4.     SArr = Range("a15:f" & [f65535].End(xlUp).Row)
   
5.     SArr1 = Range("s15:s" & [s65535].End(xlUp).Row)
   
6.     [U15:Z65535].ClearContents
   
7.    
   
8.     Set d = CreateObject("scripting.dictionary")  '第一步：把所有条件合并起来，得到每个数可以出现的全部次数
   
9.     For i = 1 To UBound(SArr1)
   
10.       tjrr = Split(Split(SArr1(i, 1), "/")(0), ",")  '条件前半部分各数
    
11.       gs = Split(SArr1(i, 1), "/")(1)    '条件后半部分 各数出现的次数
    
12.       For Each x In tjrr
    
13.         d(Val(x)) = d(Val(x)) & "~" & gs & "~"      '每个数出现的全部次数用 "~" 相连
    
14.       Next
    
15.     Next
    
16.    
    
17.     'For Each x In d.keys
    
18.     '    Debug.Print x, d(x)
    
19.     'Next
    
20.    
    
21.     Set d1 = CreateObject("scripting.dictionary")   '第二步：针对源数据每一行，比对每个数出现的次数是不是符合条件。
    
22.     For ii = 1 To UBound(SArr)
    
23.         d1.RemoveAll: Flag = True      '默认符合条件
    
24.         For jj = 1 To UBound(SArr, 2)
    
25.             x = Val(SArr(ii, jj))
    
26.             d1(x) = d1(x) + 1
    
27.         Next
    
28.         For Each x In d1.keys
    
29.             gs = Val(d1(x))
    
30.             If InStr(d(x), "~" & gs & "~") = 0 Then    '有一个条件不符合，退出循环
    
31.                 Flag = False
    
32.                 Exit For
    
33.             End If
    
34.         Next
    
35.         If Flag = True Then
    
36.             n = n + 1
    
37.             For jj = 1 To UBound(SArr, 2)
    
38.                 SArr(n, jj) = SArr(ii, jj)
    
39.             Next
    
40.         End If
    
41.     Next
    
42.     If n > 0 Then [u15].Resize(n, 6) = SArr
    
43.     MsgBox Timer - t
    
44. End Sub

复制代码

grf1973

前提是：
1/1~2
1/3~4
和
1/1~2~3~4
指的是相同条件。

laoau138

grf1973 发表于 2016-9-12 11:15

这个过滤速度提升好几倍，果然高手十分佩服

laoau138

grf1973 发表于 2016-9-12 11:17
前提是：
1/1~2
1/3~4

请grf1973 大侠，再出手一次

VBA用字典终极提速这个速度超慢

http://www.excelpx.com/thread-424377-1-1.html

雄鹰2013

grf1973 发表于 2016-9-12 11:17
前提是：
1/1~2
1/3~4

附件不能打开啊

laoau138

雄鹰2013 发表于 2016-9-22 19:15
附件不能打开啊

谁说不能打开啊，

laoau138

grf1973 发表于 2016-9-12 11:17
前提是：
1/1~2
1/3~4

         
大侠写的字典提速代码发现有错   

原来这个   只要不改变单元格S15:S22条件，结果正确U:Z列只有993行

现在化简这个          完全没有输出明显错误，               不用字典会不会更快一点