求助：改善循环运行效率

令狐风

目的是用sheet1里面的数据计算出sheet2的结果
各列计算的要求在sheet2标题的批注里

另外，sheet1里的数据每天会自动更新，新数据都是从第二行写入
比如，现在数据在2-10行，那么自动更新后数据就在2-11行，其中第2行是新数据，3-11行是前一天2-10行的旧数据

现在我完全用循环写的，由于数据量很大，程序非常慢
请问有什么好办法能提高效率吗？

感谢帮助！

工作簿1.zip (4.96 KB, 下载次数: 8)

2012-5-25 17:13 上传

点击文件名下载附件

play9091

把你的代碼也付上來吧！

令狐风

play9091 发表于 2012-5-25 17:22
把你的代碼也付上來吧！

代码都是最笨的循环
见笑了！
不过这个是针对真实的文件的，跟上面那个举例子用的附件不完全吻合

1. Sub CopyData()
   
2.   
   
3.     Dim i%, j%, sum!
   
4.     With Sheets("修正数据")
   
5.    
   
6.         For i = 3 To Sheets("原始数据1").Cells(Rows.Count, 1).End(xlUp).Row
   
7.             .Cells(i - 1, 1) = Sheets("原始数据1").Cells(i, 1)   '直接copy数据
   
8.             For j = (i - 1) To Sheets("原始数据1").Cells(Rows.Count, 1).End(xlUp).Row     '需要填充空单元格
   
9.                 If Sheets("原始数据1").Cells(j + 1, 2) <> "" Then
   
10.                     .Cells(i - 1, 2) = Sheets("原始数据1").Cells(j + 1, 2)
    
11.                     Exit For
    
12.                 End If
    
13.             Next j
    
14.             .Cells(i - 1, 3) = Sheets("原始数据1").Cells(i, 3)
    
15.             sum = 0                                                      
    
16. '需要求20周期移动平均
    
17. 
    
18.             For j = 1 To 20
    
19.                 sum = sum + Sheets("原始数据1").Cells(i + j - 1, 4)
    
20.             Next j
    
21.             .Cells(i - 1, 4) = sum / 20
    
22.             .Cells(i - 1, 5) = Sheets("原始数据1").Cells(i, 5)
    
23.             For j = (i - 1) To Sheets("原始数据1").Cells(Rows.Count, 1).End(xlUp).Row
    
24.                 If Sheets("原始数据1").Cells(j + 1, 6) <> "" Then
    
25.                     .Cells(i - 1, 6) = Sheets("原始数据1").Cells(j + 1, 6)
    
26.                     Exit For
    
27.                 End If
    
28.             Next j
    
29.             For j = 7 To 11                                       '需要做加减计算
    
30.                 .Cells(i - 1, j) = Sheets("原始数据1").Cells(i, j + 5) + .Cells(i - 1, 2) - Sheets("原始数据1").Cells(i, j)
    
31.             Next j
    
32.             For j = 12 To 15
    
33.                  .Cells(i - 1, j) = Sheets("原始数据1").Cells(i, j + 5) + .Cells(i - 1, 5) - Sheets("原始数据1").Cells(i, j - 5)
    
34.             Next j
    
35.             For j = 16 To 20
    
36.                 .Cells(i - 1, j) = Sheets("原始数据1").Cells(i, j + 10) + .Cells(i - 1, 2) - Sheets("原始数据1").Cells(i, j + 5)
    
37.             Next j
    
38.             For j = 21 To 24
    
39.                  .Cells(i - 1, j) = Sheets("原始数据1").Cells(i, j + 10) + .Cells(i - 1, 5) - Sheets("原始数据1").Cells(i, j)
    
40.             Next j
    
41.         Next i
    
42.       
    
43. End With
    
44.    
    
45.     End Sub
    

复制代码

表里如意

1. Sub auto_sheet2()
   
2.   Dim src, tmp1#, tmp2#, i&
   
3.   src = Sheet1.Range("A2", Sheet1.[A65536].End(xlUp)).Resize(, 8)
   
4.   For i = UBound(src) To 1 Step -1
   
5.   '2
   
6.      If IsEmpty(src(i, 3)) Then
   
7.        src(i, 3) = tmp1
   
8.      Else
   
9.        tmp1 = src(i, 3)
   
10.      End If
    
11. '3
    
12.    tmp2 = src(i, 4)
    
13.    src(i, 4) = src(i, 5) - tmp2
    
14.    src(i, 5) = src(i, 6) - tmp2
    
15.    src(i, 6) = src(i, 8) + src(i, 3) - src(i, 7)
    
16.   Next
    
17.   Sheet2.Range("A2").Resize(UBound(src), 6) = src
    
18. End Sub

复制代码