这个非常简单的宏需要93秒才能完成55次迭代。我也尝试过它作为下一个循环,结果相同。
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部分。我的第二个问题是没有任何值在屏幕上发布。我的第三个问题是我的日期类型与日期不匹配。我的第四个问题是,我不了解价值和价值之间的差异。
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
答案 0 :(得分:0)
问题解决了。我需要将计算更改为手动并禁用事件触发。
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