数据量大计算缓慢，想优化代码

chxw68

1. Sub CountDuplicates()
   
2.     Dim r&, i&
   
3.     Dim arr
   
4.     Dim rq As Variant
   
5.     Dim d As Object
   
6.     Set d = CreateObject("Scripting.Dictionary")
   
7.     Application.ScreenUpdating = False
   
8.     Application.DisplayAlerts = False
   
9.     With Worksheets("sum")
   
10.         rq = .Range("f2:f3")
    
11.     End With
    
12.     With Worksheets("Picking List Data")
    
13.         r = .Cells(.Rows.count, 1).End(xlUp).Row
    
14.         .Range("s2:s" & r).ClearContents
    
15.         arr = .Range("a2:s" & r)
    
16.         For i = 1 To UBound(arr)
    
17.             If arr(i, 17) > rq(1, 1) And arr(i, 17) < rq(2, 1) Then
    
18.                 xm = arr(i, 1) & "+" & arr(i, 4) & "+" & arr(i, 5)
    
19.                 d(xm) = d(xm) + 1
    
20.             End If
    
21.         Next
    
22.         For i = 1 To UBound(arr)
    
23.             If arr(i, 17) > rq(1, 1) And arr(i, 17) < rq(2, 1) Then
    
24.                 xm = arr(i, 1) & "+" & arr(i, 4) & "+" & arr(i, 5)
    
25.                 If d.exists(xm) Then
    
26.                     arr(i, 19) = d(xm)
    
27.                 End If
    
28.             End If
    
29.         Next
    
30.         .Range("s2").Resize(UBound(arr), 1) = Application.Index(arr, 0, 19)
    
31.     End With
    
32.     Application.ScreenUpdating = True
    
33.     MsgBox "统计完毕！"
    
34. End Sub
    

复制代码

chxw68

使用数组速度能快很多。

fenghuaxue

用数组，几十万有可能内存就爆了。