Excel的VBA For循環導致100％的CPU

Question

Application.ScreenUpdating = False 
Dim r As Range 
Dim a As Long 


Set op = Worksheets("ZVCTOSTATUS") 
Set CP = op.Columns("J") 
Set CTO = op.Range("J1") 
Set OD = op.Columns("G") 
Set ZV = op.Columns("H") 

op.Activate 
fa = op.Range("J" & Rows.Count).End(xlUp).Row 
Set r = op.Range("J2:J" & fa) 

For Each C In r 
    CTO = CP.Cells(C.Row, 1).Value 
    If CTO = "FG BOOKED" Or CTO = "CLOSED" Then 
     ZV.Cells(C.Row, 1) = 0 
    ElseIf CTO = "NOT STARTED" Or CTO = "UNCONFIRMED" Then 
     ZV.Cells(C.Row, 1) = OD.Cells(C.Row, 1).Value 
End If 
Next C 

嗨，大家好，我使用這個代碼要經過我的工作做一個for循環引用列J.

當此代碼更改列H值在獨立的工作表上使用它似乎工作得很好，但是一旦我將它移植到一個更大的文件中，這個文件有數據連接，並且我單獨運行這個宏，它會導致我的CPU以100％的速度運行並且最多需要10分鐘。

有誰知道爲什麼會發生這種情況？

Answer 1

爲了幫助您的宏運行更流暢，您可以在主代碼之前（在子代之下）和代碼之後插入以下代碼（在結束之前） 這將關閉屏幕更新，提醒並設置計算爲手動，所以沒有公式正在更新，直到該進程已經運行。

'Please Before Main Code' 
    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 
    Application.Calculation = xlManual 

    'Insert main code here' 

    'Place After Main code' 
    Application.ScreenUpdating = True 
    Application.DisplayAlerts = True 
    Application.Calculation = xlAutomatic 

Answer 2

看來你在它具有以下特點陷阱下跌：

1. 您使用的是較大的Excel文件，該文件是在大小數MB
2. Excel文檔充滿公式和數據連接
的
3. 此外，它可能有數據透視表和圖表
的公式計算
4. 選擇是自動

試試這個： 1.轉到公式選項卡 2.單擊「計算選項」 3.選擇「手動」

現在執行你已經創建的宏。應該很好去。一旦宏被執行。您可以更改計算選項。

注意：可以控制有問題以及使用以下代碼段的計算選項：每次任何小區改變

Dim CalcMode As Long 
    ' This will set the calculation mode to manual 
    With Application 
     CalcMode = .Calculation 
     .Calculation = xlCalculationManual 
     .ScreenUpdating = False 
     .EnableEvents = False 
    End With 

    << Add your macro processing here >> 

    ' Again switch back to the original calculation option 
    With Application 
     .ScreenUpdating = True 
     .EnableEvents = True 
     .Calculation = CalcMode 
End With 

Excel嘗試計算值（基於式）。這是爲您的宏更新的每個單元的整個文檔完成的。所以，對於大型的Excel文檔，它會導致高CPU消耗。

Answer 3

您正在一次設置一個單元格的值，從而觸發重新計算。正確執行此操作的方法是首先將列讀入內存，然後設置值並將結果寫入一個操作。

Public Sub AnswerPost() 

    Dim r_status As Range, r_value As Range, r_calc As Range 
    Dim i As Long, n As Long 
    Dim op As Worksheet 

    Set op = Worksheets("ZVCTOSTATUS") 
    ' Find the number of items on cell "J2" and below 
    n = Range(op.Range("J2"), op.Range("J2").End(xlDown)).Rows.Count 
    ' Set the n×1 range of cells under "J", "G" and "H" columns 
    Set r_status = op.Range("J2").Resize(n, 1) 
    Set r_value = op.Range("G2").Resize(n, 1) 
    Set r_calc = op.Range("H2").Resize(n, 1) 

    Dim x_status() As Variant, x_value() As Variant, x_calc() As Variant 
    ' Read cells from the worksheet into memory arrays 
    x_status = r_status.Value2 
    x_value = r_value.Value2 
    x_calc = r_status.Value2 
    ' Set values of x_calc based on x_status, row by row. 
    For i = 1 To n 
     Select Case x_status(i, 1) 
      Case "FG BOOKED", "CLOSED" 
       x_calc(i, 1) = 0# 
      Case "NOT STARTED", "UNCONFIRMED" 
       x_calc(i, 1) = x_value(i, 1) 
     End Select 
    Next i 
    ' Write the resulting array back into the worksheet 
    r_calc.Value2 = x_calc 
End Sub 

測試用例上面的代碼