[已解决]如何提高C,D,E列的运算速度？

13782671637

员工完成任务先后顺序预测.zip (24.64 KB, 下载次数: 9)

2017-1-12 19:04 上传

点击文件名下载附件
  C,D,E列的公式都正确。但行数多的时候特别慢，经大神们介绍，来VBA板块，哪位大神能解决问题？本人表示感谢！

最佳答案

月排行榜 / 总排行榜

grf1973

2017-1-13 21:58

结果输出在FG列，以便比较。

1. Sub tt()
   
2.     arr = Range("a1:b" & [b65536].End(3).Row)
   
3.     ReDim brr(1 To UBound(arr), 1 To 2)
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     For i = 5 To UBound(arr) - 1
   
6.         x = arr(i, 2): d(x) = ""
   
7.         For j = i + 1 To UBound(arr)
   
8.             y = arr(j, 2): d(y) = ""
   
9.             If y = x Then
   
10.                 brr(j, 1) = d.Count
    
11.                 d.RemoveAll
    
12.                 Exit For
    
13.             End If
    
14.         Next
    
15.     Next
    
16.    
    
17.     d.RemoveAll
    
18.     For i = 6 To UBound(arr)
    
19.         x = arr(i, 1)
    
20.         For j = i - 1 To 5 Step -1
    
21.             y = arr(j, 2): d(y) = ""
    
22.             If d.Count = x Then
    
23.                 brr(i, 2) = arr(j, 2)
    
24.                 Exit For
    
25.             End If
    
26.         Next
    
27.         d.RemoveAll
    
28.     Next
    
29.    
    
30.    
    
31.     [f1].Resize(UBound(arr), 2) = brr
    
32. End Sub

复制代码

跳转到最佳答案楼层

grf1973

结果输出在FG列，以便比较。

1. Sub tt()
   
2.     arr = Range("a1:b" & [b65536].End(3).Row)
   
3.     ReDim brr(1 To UBound(arr), 1 To 2)
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     For i = 5 To UBound(arr) - 1
   
6.         x = arr(i, 2): d(x) = ""
   
7.         For j = i + 1 To UBound(arr)
   
8.             y = arr(j, 2): d(y) = ""
   
9.             If y = x Then
   
10.                 brr(j, 1) = d.Count
    
11.                 d.RemoveAll
    
12.                 Exit For
    
13.             End If
    
14.         Next
    
15.     Next
    
16.    
    
17.     d.RemoveAll
    
18.     For i = 6 To UBound(arr)
    
19.         x = arr(i, 1)
    
20.         For j = i - 1 To 5 Step -1
    
21.             y = arr(j, 2): d(y) = ""
    
22.             If d.Count = x Then
    
23.                 brr(i, 2) = arr(j, 2)
    
24.                 Exit For
    
25.             End If
    
26.         Next
    
27.         d.RemoveAll
    
28.     Next
    
29.    
    
30.    
    
31.     [f1].Resize(UBound(arr), 2) = brr
    
32. End Sub

复制代码

laoau138

grf1973 发表于 2017-1-13 21:58
结果输出在FG列，以便比较。

VBA计算A列左右两边   两数和两数差平均值   分两种情况


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