[已解决]优化代码

jkczfpb

我用VBA制作了一些工具，用到了循环处理，为什么循环次数越多，速度越慢？
比如对身份证号码进行审核，当审核1000条信息时需要3秒，审核5000条信息就需要29秒，审核10000条信息则需要150秒。

请问类似问题怎么解决？

最佳答案

月排行榜 / 总排行榜

liuguansky

2011-12-29 09:33

1. with createobject("scripting.dictionary")
   
2. For i = 1 To UBound(niV)
   
3.           if d.exists(niv(i)) then
   
4.                d.add niv(i),0
   
5.          else
   
6.               d(niv(i))=1
   
7.           endif
   
8. next
   
9. For i = 1 To UBound(niV)
   
10.             If d(niv(i))> 0 And len(Vsfz(i, 2)) Then Vsfz(i, 3) = "重复！" & Vsfz(i, 3)
    
11. next
    
12. set d=nothing

复制代码

这样试下？

跳转到最佳答案楼层

liuguansky

上传实际的附件才好分析。

liuts

应该没放到数组里吧

青城山苦丁茶

老鸟遇到新问题？
这的确是要具体问题具体分析。
给个模拟数据和你的代码，看看速度能不能有些许的提升

吕?布

也许是随着循环次数增加，累计占用有内存越来越多，可用内存越来越少，速度越来越慢
也许可以考虑中间释放不用的内存，或者分段循环

jkczfpb

青城山苦丁茶 发表于 2011-12-28 15:50
老鸟遇到新问题？
这的确是要具体问题具体分析。
给个模拟数据和你的代码，看看速度能不能有些许的 ...

惭愧的很，菜鸟而已。
全是东拼西凑的洋码字。
工具大的很，我加你QQ传你

jkczfpb

吕?布 发表于 2011-12-28 21:33
也许是随着循环次数增加，累计占用有内存越来越多，可用内存越来越少，速度越来越慢
也许可以考虑中间释放 ...

主要是这段代码运行慢了
        For i = 1 To UBound(niV)
            If UBound(VBA.Filter(niV, niV(i), True)) > 0 And Vsfz(i, 2) <> "" Then Vsfz(i, 3) = "重复！" & Vsfz(i, 3) 'Application.WorksheetFunction.SumProduct((niV = niV(i)) * 1) > 1 Then Vsfz(i, 3) = "重复！" & Vsfz(i, 3)
        Next

liuguansky

1. with createobject("scripting.dictionary")
   
2. For i = 1 To UBound(niV)
   
3.           if d.exists(niv(i)) then
   
4.                d.add niv(i),0
   
5.          else
   
6.               d(niv(i))=1
   
7.           endif
   
8. next
   
9. For i = 1 To UBound(niV)
   
10.             If d(niv(i))> 0 And len(Vsfz(i, 2)) Then Vsfz(i, 3) = "重复！" & Vsfz(i, 3)
    
11. next
    
12. set d=nothing

复制代码

这样试下？

吕?布

试试这样呢
Sub tt()
    For i = 1 To UBound(niV)
        If Len(Vsfz(i, 2)) > 0 Then
            If IsRepetitive(niV, niV(i), True) > 0 Then Vsfz(i, 3) = "重复！" & Vsfz(i, 3)
        End If
    Next
End Sub

Function IsRepetitive(SourceArray, ByVal Match As String, Optional Include As Boolean = True) As Boolean
    Dim i As Long
    Dim lCount As Long
    Dim sMatch As String

    IsRepetitive = False
    sMatch = "*" & Match & "*"
    For i = LBound(SourceArray) To UBound(SourceArray)
        If SourceArray(i) Like sMatch Then
            lCount = lCount + 1
            If lCount > 1 Then
                IsRepetitive = True
                Exit For
            End If
        End If
    Next i
End Function

jkczfpb

liuguansky 发表于 2011-12-29 09:33
这样试下？
也是只有试过才知道，吕布的循环5万次也比我的循环一次快，用字典就更快了

这个需要循环两次，那个只需要循环一次