VBA 매크로를 실행하는 데 너무 오래 걸림

Question

이 매우 간단한 매크로는 55 회 반복 실행하는 데 93 초 밖에 걸리지 않습니다. 나는 또한 다음 루프, 같은 결과를 위해 그것을 시도했다.

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" 

확인 FIRST UPDATE, 나는 다른 페이지를 쳐다 보면서 그들은 기능과 함께를 사용하는 것이 좋습니다. 나는 그것을했고 그것은 여전히 ​​15 세포를 통해 루프 28 초 걸렸습니다.

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" 

THIRD UPDATE

좋아, 나는 몇 가지 조사를 한 적이 그리고 당신이 범위에서 루프를 생각하지 않을 것을 당신이 배열의 범위를 넣어 야지 것을 배웠다. 나는 이것을 정말로 이해하지 못한다. 그러나 배열에 셀을 넣고 각 피쳐에 for를 사용하려고 시도했다. 그것은 여전히 ​​범위를 반복하고있는 것처럼 보이지만, 함수에 들어가는 단계가있을 때마다 코드의 부분을 넘어가는 데 아주 오랜 시간이 걸리기 때문입니다. 두 번째 문제는 값이 화면에 게시되지 않는다는 것입니다. 세 번째 문제는 thedate와 형식이 일치하지 않는다는 것입니다. 나의 네 번째 문제는 내가 betwene 값과 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" 

4TH UPDATE

나는 작동하는 새로운 코드를 가지고 있지만 여전히 50 반복을 통해 실행 78 초가 걸립니다. 문제가 무엇인지 이해하지 마십시오.

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 

Answer 1

문제가 해결되었습니다. 계산을 수동으로 변경하고 이벤트 실행을 중지해야합니다.

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