[已解决]代码提速问题！

suxiong

1. Sub TEST()
   
2. 
   
3.     Dim t
   
4.     t = Timer
   
5. 
   
6.     Application.ScreenUpdating = True
   
7.    
   
8.         Sheets("Sheet2").Range("a2:c100000").Clear
   
9. 
   
10. 
    
11.     On Error Resume Next
    
12.     Dim x, y As Integer
    
13.     For x = 2 To Sheet1.Range("B100000").End(3).Row    'A点Lon
    
14.         For y = 2 To Sheet1.Range("E100000").End(3).Row    'b点Lon
    
15.             Sheet2.Range("C200000").End(3).Offset(1, 0) = NED(Sheet1.Cells(x, 3), Sheet1.Cells(y, 6), Sheet1.Cells(x, 2), Sheet1.Cells(y, 5))
    
16.             Sheet2.Range("b1000000").End(3).Offset(1, 0) = Sheet1.Range("d" & y)    '填SHEET2的B列
    
17.             Sheet2.Range("a1000000").End(3).Offset(1, 0) = Sheet1.Range("a" & x)    ''填SHEET2的a列
    
18.         Next y
    
19. 
    
20.     Next x
    
21.     Application.ScreenUpdating = True
    
22. 
    
23.     MsgBox (Timer - t)
    
24. End Sub
    
25. 
    
26. 
    

复制代码

复件 ne.zip (196.1 KB, 下载次数: 8)

2014-1-6 11:37 上传

点击文件名下载附件

普通循环与数组我都写了，速度很慢！麻烦下各位！

最佳答案

月排行榜 / 总排行榜

fffox

2014-1-6 12:25

原来的代码在我的电脑上要运行将近9秒，现在的代码不到0.2秒

主要是原来的代码虽然用了数组，但里面的读写基本上还都是单元格操作，严重影响了操作效率

跳转到最佳答案楼层

fffox

在代码开头，应该是Application.ScreenUpdating=False
结束时Application.ScreenUpdating=True，相互呼应。
开始时把Application.ScreenUpdating=True，到执行效率有影响

suxiong

fffox 发表于 2014-1-6 12:01
在代码开头，应该是Application.ScreenUpdating=False
结束时Application.ScreenUpdating=True，相互呼应。 ...

谢谢，我看错了。
但这个影响不是很大，我想最少要提速10倍才行。数据太多了。

fffox

1. 
   

复制代码

fffox

suxiong 发表于 2014-1-6 12:03
谢谢，我看错了。
但这个影响不是很大，我想最少要提速10倍才行。数据太多了。

1. Sub TEST1()
   
2. 
   
3.     Dim t
   
4.     t = Timer
   
5. 
   
6.     Application.ScreenUpdating = False
   
7.     '计算值
   
8.     'Sheets("Sheet2").Range("a2:c100000").Clear
   
9.     On Error Resume Next
   
10.     Dim arr1, arr2, brr()
    
11.     Dim x%, x1 As Integer, i%
    
12.     With Sheets("sheet1")
    
13.         arr1 = .Range("a2:c" & .Range("c100000").End(3).Row)     'A点Lon
    
14.         arr2 = .Range("d2:f" & .Range("f100000").End(3).Row)   'b点Lon
    
15.     End With
    
16.     ReDim brr(1 To UBound(arr1) * UBound(arr2), 1 To 3)
    
17.     For x = 1 To UBound(arr1, 1)    '行
    
18.         For x1 = 1 To UBound(arr2, 1)    '行
    
19.             i = i + 1
    
20.             brr(i, 3) = NED(arr1(x, 3), arr2(x1, 3), arr1(x, 2), arr2(x1, 2))
    
21.             brr(i, 2) = arr2(x1, 1) '填SHEET2的B列
    
22.             brr(i, 1) = arr1(x, 1) '填SHEET2的a列
    
23.         Next x1
    
24.     Next x
    
25.     With Sheets("sheet2")
    
26.         .Range("a2", .Cells(Rows.Count, 3).End(3)).ClearContents
    
27.         .Range("a2").Resize(i, 3) = brr
    
28.     End With
    
29.     Application.ScreenUpdating = True
    
30.     MsgBox (Timer - t)
    
31. End Sub

复制代码

fffox

原来的代码在我的电脑上要运行将近9秒，现在的代码不到0.2秒

主要是原来的代码虽然用了数组，但里面的读写基本上还都是单元格操作，严重影响了操作效率