Excel VBA刪除基於if語句的行（加速）

我正在刪除基於P列中的值的行。P列中的單元格具有if語句：IF（K < 10,0,1）Excel VBA刪除基於if語句的行（加速）

如果列P中的值爲0，則需要刪除該行。我正在使用下面的宏，但需要很長時間。我想要處理大約10000行。

如果我對加速此代碼有一些建議，我們將不勝感激。

[我如果使用這種嘗試語句：IF（K < 10，「」，1），然後刪除使用SpecialCells（XlCellTypeBlanks）行，但該細胞不會被解釋爲空白，由於的存在公式我認爲。 ]

Sub RemoveBlankRows() 

    Application.ScreenUpdating = False 
    'PURPOSE: Deletes any row with 0 cells located inside P 
    'Reference: www.TheSpreadsheetGuru.com 

    Dim rng As Range 
    Dim blankrng As Range 
    Dim cell As Range 

    'Store blank cells inside a variable 
    'On Error GoTo NoBlanksFound 
Set rng = Range("P2:P30000") '.SpecialCells(xlCellTypeBlanks) 
'On Error GoTo 0 

For Each cell In rng 
If cell.Value = 0 Then 
    cell.EntireRow.Delete 
    'Value = "" 
End If 
Next 

Application.ScreenUpdating = True 
End Sub

來源

2016-10-24 E Kadwa

http://stackoverflow.com/questions/33744149/code-in-vba-loops-and-never-ends-how-to-fix-this –

排序怎麼樣？你可以對你的表/數據進行排序，將你的'0'單元分組在一起，然後用'0'獲取第一行和最後一行，並刪除範圍？ – BruceWayne

這看起來對，避免空白：

Sub RowKiller() 
    Dim rKill As Range, r As Range, rng As Range 

    Set rng = Range("P2:P30000") 
    Set rKill = Nothing 

    Application.ScreenUpdating = False 
    Application.Calculation = xlCalculationManual 
    Application.EnableEvents = False 

    For Each r In rng 
     If r.Value = 0 And r.Value <> "" Then 
      If rKill Is Nothing Then 
       Set rKill = r 
      Else 
       Set rKill = Union(rKill, r) 
      End If 
     End If 
    Next r 

    If Not rKill Is Nothing Then rKill.EntireRow.Delete 

    Application.ScreenUpdating = True 
    Application.Calculation = xlCalculationAutomatic 
    Application.EnableEvents = True 

End Sub

這只是演示代碼。量身定製它來滿足您的需求。

來源

2016-10-24 14:36:17

非常感謝你 –

完美的作品 –

Excel VBA刪除基於if語句的行（加速）

回答

相關問題