根據空白單元格刪除整行的最快方法

Question

根據特定列中的空白單元格刪除整行的方法有很多種。我想知道的是，以Excel速度來說，哪個是最快完成此任務的方法。我有一張大約39,000行原始行數據，然後在運行下面的代碼後變成21,000行。問題是大量的代碼需要將近60秒才能返回。雖然我知道CPU和這是一個因素，但讓我們假設其他所有條件都是平等的。

我使用列A作爲行數和列F的總計數作爲空白單元格的位置。這是寫這段代碼的最好還是最快的方法？

'發現最後一排有一個文件編號，並刪除其餘的行

Dim LastRow As Integer 
LastRow = Range("A" & Rows.Count).End(xlUp).Row 
Range("F2:F" & LastRow).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 

Answer 1

試試這個（希望這會有所幫助，雖然之前把你的表的備份！）：

Sub FastestBlankRowTerminator() 
ActiveSheet.UsedRange.Columns(6).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 
End Sub 

Answer 2

我建立了一個50,000行×12列的矩陣。在F欄中，我隨機放置了大約25,000個空格。

• 閱讀所使用的區域到一個數組
• 迭代通過陣列和讀與F列內容的那些行到結果陣列
• 清除原始數據
• 結果寫入陣列

很多步驟，但執行時間少於一秒;屏幕更新錯誤可能會更快;如果你有更多的專欄則時間更長。

編輯：屏幕更新錯誤並沒有顯着降低執行速度，當使用高分辨率定時器定時時，執行速度大約爲0.36秒。

EDIT2：在閱讀Tim Williams關於保存格式和公式的評論之後，我提出了一種不同的方法。這種方法將使用高級過濾器，並在與上述相同的數據上，將數據放在另一個工作表中，減去列F中具有空白的行。這需要數據中的第一行列標題;或者至少，F1具有唯一的非空白值。

要完成該過程大約需要0.15秒。 如果您還想將其複製到原始工作表上，並刪除添加的工作表，則需要大約0.3秒。

下面是一些代碼來做到這一點，但你必須改變它自己的規格：

===================== =========================

Sub DeleteBlankFRows2() 
    Dim WS As Worksheet, wsTemp As Worksheet, rTemp As Range 
    Dim R As Range, rCrit As Range 
    Dim I As Long 
Set WS = Worksheets("Sheet5") 
Set R = WS.Range("a1").CurrentRegion 
Set rCrit = R.Offset(0, R.Columns.Count + 3).Resize(2, 1) 
    rCrit(1) = R(1, 6) 
    rCrit(2) = "<>" 

Application.ScreenUpdating = False 
Worksheets.Add 
    Set wsTemp = ActiveSheet 
    wsTemp.Name = "Temp" 
    R.AdvancedFilter xlFilterCopy, rCrit, Cells(1, 1) 
    Set rTemp = wsTemp.Cells(1, 1).CurrentRegion 
WS.Cells.Clear 
rTemp.Copy WS.Cells(1, 1) 

Application.DisplayAlerts = False 
wsTemp.Delete 
Application.DisplayAlerts = True 

Application.ScreenUpdating = True 

End Sub 

================== =====================

這是使用VBA陣列我的原代碼：

============ ===============

Sub foo() 
    Dim vSrc As Variant, vRes() As Variant 
    Dim rSrc As Range 
    Dim I As Long, J As Long, K As Long 
    Dim lRows As Long 

'Or may need to use a different method to include everything 
Set rSrc = Range("a1").CurrentRegion 
vSrc = rSrc 

'how many rows to retain 
For I = 1 To UBound(vSrc) 
    If vSrc(I, 6) <> "" Then lRows = lRows + 1 
Next I 

ReDim vRes(1 To lRows, 1 To UBound(vSrc, 2)) 
K = 0 
For I = 1 To UBound(vSrc) 
    If vSrc(I, 6) <> "" Then 
     K = K + 1 
     For J = 1 To UBound(vSrc, 2) 
      vRes(K, J) = vSrc(I, J) 
     Next J 
    End If 
Next I 

Cells.Clear 
Range("a1").Resize(UBound(vRes, 1), UBound(vRes, 2)) = vRes 

End Sub 

Answer 3

我可以建議的最簡單的事情之一是應該通過顯着的數量提高性能，這是在運行此過程時關閉屏幕更新和自動計算。

我通常在初始調用代碼時關閉這些項目，並在最後一個代碼後將它們重新打開。這意味着我將有一個子包含一系​​列其他子和函數，它們將按順序執行。而不是將它們分別嵌入到這些子集和函數中，我只是將它們設置爲off，執行main子集，然後重置它們。

' Speed Up 
application.screenupdating = false 
application.calculation = xlCalculationManual 

<insert code you want to improve performance on here>  

' Slow Down 
application.screenupdating = true 
application.calculation = xlCalculationAutomatic 

我跑測試自己填充柱帶有一個行數高達39000，然後每隔記錄將F列有一個「1」。

我的core2duo仍然需要一些時間，但只有46秒，如果我不關閉屏幕更新需要3分34秒。

Sub Main() 
    ' Speed Up 
    Application.ScreenUpdating = False 
    Application.Calculation = xlCalculationManual 

    Begin ' Main Sub 

    ' Reset 
    Application.ScreenUpdating = True 
    Application.Calculation = xlCalculationAutomatic 
End Sub 

Sub Begin() 
    ' Sub 1 
    ' Sub 2 
    ' Sub 3 
    Remove_Blanks 
End Sub 

Sub Remove_Blanks() 
    Dim dA As Date, dB As Date 
    Dim wb As Workbook 
    Dim ws As Worksheet 

    Dim i As Long, j As Integer 
    Dim r As Long, c As Integer 

    dA = Now 

    ' Commented out to indicate they could be here but if you are executing multiple procedures then you should have it occur outside of this. 
    'Application.ScreenUpdating = False 
    'Application.Calculation = xlCalculationManual 

    Set wb = ThisWorkbook 
    Set ws = wb.Sheets("Sheet1") 

    With ws 
     For r = 1 To .UsedRange.Rows.Count 
      If .Cells(r, 6) = "" Then .Rows(r).Delete 
     Next r 
    End With 
    dB = Now 

    'Commented out for same reason above 
    'Application.ScreenUpdating = True 
    'Application.Calculation = xlCalculationAutomatic 

    Debug.Print "Remove_Blanks: " & Format((dB - dA), "mm/dd/yyyy hh:mm:ss") 
End Sub