VBA字典改错兼提速

laoau138

VBA字典改错兼提速

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

这个字典提速比数组过滤速度快5倍  可惜字典提速有错如何改

数组过滤   
zhjlgaojuan     结果正确U:Z列只有993行

字典提速有错误，如何改
grf1973       结果有点错误U:Z列有1716行,正确结果 U:Z列只有993行

雄鹰2013

看看，学习一下

pengyx

grf1973 的算法有问题，结果自然不对

laoau138

雄鹰2013 发表于 2016-9-26 20:03
看看，学习一下

有错快点改

laoau138

pengyx 发表于 2016-9-26 20:11
grf1973 的算法有问题，结果自然不对

错在哪里如何改

pengyx

是算法有问题，不代码有问题。代码没问题如何改代码。看清楚再提要求

pengyx

没法改，只有造了重来

laoau138

pengyx 发表于 2016-9-26 21:24
没法改，只有造了重来

不知道你这两句话的含意

雄鹰2013

Sub 测试()
Dim arr, ar, br, cr, brr
t = Timer
Sheets("测试").Range("t15:z" & Cells(Rows.Count, 26).End(xlUp).Row) = ""
Set d = CreateObject("scripting.dictionary") '原数据
Set dd = CreateObject("scripting.dictionary") '过滤条件
arr = Sheets("测试").Range("a15:f" & Cells(Rows.Count, 6).End(xlUp).Row)
ar = Application.Transpose(Sheets("测试").Range("s15:s" & Cells(Rows.Count, 19).End(xlUp).Row))
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2) + 1)
For i = 1 To UBound(arr)
     d.RemoveAll
     m = 0
     For j = 1 To UBound(arr, 2)
         d(CInt(arr(i, j))) = ""
     Next j
     For ii = 1 To UBound(ar)
         dd.RemoveAll
         n = 0
         br = Split(Split(ar(ii), "/")(0), ",")
         cr = Split(Split(ar(ii), "/")(1), "~")
         For k = 0 To UBound(cr)
             dd(CInt(cr(k))) = ""
         Next k
         For iii = 0 To UBound(br)
             If d.exists(CInt(br(iii))) Then
                n = n + 1
                If dd.exists(n) Then
                   m = m + 1
                   GoTo 100
                End If
             Else
                If n = 0 And dd.exists(n) Then
                   m = m + 1
                   GoTo 100
                End If
             End If
         Next iii
         If m <> ii Then GoTo 10
100: Next ii
    If m = UBound(ar) Then
       s = s + 1
       For j = 1 To UBound(arr, 2)
            brr(s, 1) = s
            brr(s, j + 1) = arr(i, j)
       Next j
   End If
10: Next i
MsgBox Timer - t
Sheets("测试").[t15].Resize(s, UBound(brr, 2)) = brr
End Sub

雄鹰2013

感觉有2275行，楼主可以看看
运行速度在5秒左右