excel VBA宏执行时间过长

2ic8powd  于 2022-12-24  发布在  其他
关注(0)|答案(1)|浏览(331)

这个非常简单的宏只需要93秒就可以运行55次迭代。我还尝试了它作为一个for next循环,同样的结果。

Dim thedate As Date
Dim current_cell As Long
Dim f As Single
f = Timer()

current_cell = Range("e65000").End(xlUp).Row

thedate = Range("e" & current_cell).Value
Dim i As Integer
Application.ScreenUpdating = False

Do Until Range("f" & current_cell).Value = ""
i = i + 1
If i = 900 Then
End
End If

    If Range("g" & current_cell).Value <> "x" Then
    Cells(current_cell, "e").Value = thedate
    Else
    thedate = thedate + 1
    Cells(current_cell, "e").Value = thedate
    End If
current_cell = current_cell + 1

Loop

Application.ScreenUpdating = True
MsgBox "ET: " & Format(Timer - f, "0.000") & "s"
    • 首次更新**

好的,我看了另一页,他们推荐使用with功能。我照做了,仍然花了28秒循环通过15个单元格。

Dim thedate As Date
Dim current_cell As Long
Dim f As Single
f = Timer()

current_cell = Range("e65000").End(xlUp).Row

Dim stop_working As Long
stop_working = Range("f65000").End(xlUp).Row - 1

thedate = Range("e" & current_cell).Value
Dim i As Integer
Application.ScreenUpdating = False

With Sheets("time")

For k = current_cell To stop_working
i = i + 1
If i = 900 Then
End
End If

    If .Range("g" & current_cell).Value <> "x" Then
    .Cells(current_cell, "e").Value = thedate
    Else
    thedate = thedate + 1
    .Cells(current_cell, "e").Value = thedate
    End If
    current_cell = current_cell + 1

Next

End With

Application.ScreenUpdating = True
MsgBox "ET: " & Format(Timer - f, "0.000") & "s"
    • 第三次更新**

好的,我做了一些研究,我了解到你不应该在范围内循环,你应该把范围放在一个数组中。我真的不明白这一点,但我确实试着把单元格放在一个数组中,并使用for each特性。它仍然看起来像我'我在范围上循环,因为无论何时单步执行函数,仍然需要很长时间才能跨越代码的rng部分。我的第二个问题是没有一个值被发布到屏幕上,我的第三个问题是我得到了一个与日期不匹配的类型,我的第四个问题是我不明白value和value2之间的区别。

Sub dates()

Dim thedate
Dim current_cell As Long
Dim f As Single
f = Timer()
Dim rng As Range, rng2 As Range

current_cell = Range("e65000").End(xlUp).Row

Dim done As Long
done = Range("f65000").End(xlUp).Row - 1

Set rng = Range("g" & current_cell, "g" & done)
Set rng2 = Range("e" & current_cell, "e" & done)

thedate = Format(thedate, Date)
thedate = rng2.Value
'thedate = rng2.Value
Dim i As Integer
i = 7
'Application.ScreenUpdating = False

'With Sheets("time")

For Each cell In rng




    If cell.Value <> "x" Then
    rng2.Value = thedate
    Else
    thedate = thedate + 1
    rng2.Value = thedate
    End If


Next

'End With

'Application.ScreenUpdating = True
MsgBox "ET: " & Format(Timer - f, "0.000") & "s"
    • 第4次更新**

我有一个新的代码,工作,但它仍然需要78秒,通过50次迭代运行。不明白是什么问题。

Dim iRow As Long, erow As Long
erow = Cells(Rows.Count, "e").End(xlUp).Row
Dim thedate As Date
Dim f As Single
f = Timer()

    For iRow = erow To 35856
        If Cells(iRow, "G") = "x" Then

            Cells(iRow, "E").Value = Cells(iRow - 1, "E").Value + 1
        Else
            Cells(iRow, "E").Value = Cells(iRow - 1, "E").Value
        End If

    Next iRow

    MsgBox "ET: " & Format(Timer - f, "0.000") & "s"
End Sub
7fhtutme

7fhtutme1#

问题解决了。我需要将计算改为手动并禁用事件触发。

Application.Calculation = xlCalculationManual
Application.EnableEvents = False

For iRow = 3 To Cells(Rows.Count, "G").End(xlUp).Row
    If Cells(iRow, "G") = "x" Then
        Cells(iRow, "E").Value = Cells(iRow - 1, "E").Value + 1
    Else
        Cells(iRow, "E").Value = Cells(iRow - 1, "E").Value
    End If
Next iRow

Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

相关问题