如果提高FOR的效率？

wwgo

Sub i10000()
Dim arr(10000)
For i = 0 To 9999
    [A1] = i
    [G4].Offset(i) = [G1]
    [H4].Offset(i) = [H1]
    If [G1].Text = "#DIV/0!" Or [G1].Text = "#NUM!" Then [G4].Offset(i) = "-"
Next i
End Sub
上面这段代码中A1单元格是10000个变量的编号（0-9999），每个变量含有5个数值，依次替换这5个数值，得到10000个结果，但执行效率太慢，计算过程要1个小时左右，请问老师们有没有更好的解决方案？

zax010

知道定义数组，为何不用数组？

mzbao

这个运行时间长，应该不是for效率导致的，而是你代码频繁从工作表中读写数据导致的吧。看这几行代码，怎么也不是1小时吧。

mzbao

你该代码改成这样试试

1. 
   
2. Sub i10000()
   
3.     Dim arr(0 To 10000), strTxt$, i&
   
4.    
   
5.     If IsError(Range("G1").Value) Then
   
6.         strTxt = "-"
   
7.     Else
   
8.         strTxt = Range("G1").Value
   
9.     End If
   
10. 
    
11.     For i = 0 To 9999
    
12.         arr(i) = i
    
13.     Next i
    
14.     Range("A1").Resize(10000) = Application.Transpose(arr)
    
15.     Range("G4").Resize(10000) = strTxt
    
16.     Range("H4").Resize(10000) = Range("H1").Value
    
17. End Sub

复制代码

Zamyi

1. Sub tt()
   
2. n = 10000
   
3. Range("g1:h1").Copy Range("g4:h" & n + 4)
   
4. Range("g4:h" & n + 4) = Range("g4:h" & n + 4).Value
   
5. Range("g1:g" & n + 4).Replace "#DIV/0!", "-"
   
6. Range("g4:g" & n + 4).Replace "#NUM!", "-"
   
7. End Sub

复制代码

wwgo

Zamyi 发表于 2017-4-27 09:39

A1单元格是10000个变量的编号（0-9999），每个变量含有5个数值，依次替换这5个数值
这个要求没有达到

maditate

从楼主的主贴上看，循环10000次，每次给A1单元格赋值，但在后面的代码中也没用到此单元格的值。因此我猜测，此单元格的值被其它单元格用公式调用了。也就是说，每次循环，工作表上的函数要进行一遍自动运算。
工作表上存在大量函数，工作效率肯定是没法提高的。

wwgo

mzbao
A1单元格是10000个变量的编号（0-9999），每个变量含有5个数值，依次替换这5个数值
这个要求没有达到

wwgo

maditate 发表于 2017-4-27 10:28
从楼主的主贴上看，循环10000次，每次给A1单元格赋值，但在后面的代码中也没用到此单元格的值。因此我猜测 ...

一点办法也没有？能帮忙看看？详见附件 数据计算 如果提高效率.rar (627.41 KB, 下载次数: 11)

2017-4-27 12:22 上传

点击文件名下载附件

山菊花

Sub ii10000()
    Dim arr(10000, 1), g1
    Application.ScreenUpdating = False
    For i = 0 To 9999
        Range("A1").Value = i
        g1 = Range("G1").Value
        If IsError(g1) Then
            arr(i, 0) = "-"
        Else
            arr(i, 0) = g1
        End If
        arr(i, 1) = Range("H1").Value
    Next i
    Range("g4:h10003").Value = arr
    Application.ScreenUpdating = True
End Sub