VBA宏快速刪除行

Question

我有幾個非常大的ex​​cel數據文件，我需要通過它們全部並刪除T列中單元格的值爲1的所有行。現在我的代碼看起來像：

Sub test() 
    Dim cell As Range 

    For Each cell In Worksheets("Sheet1").Range("T5", "T900000") 
     If cell.Value = 1 Then 
      cell.EntireRow.Delete 
     End If 
    Next cell 
End Sub 

它似乎在工作，但需要永遠運行，我將不得不這樣做很多次。有沒有更好的方法來做到這一點，或者有什麼方法來優化我已經有的讓它跑得更快？

Answer 1

這不符合您的想法...當您在遍歷它們時刪除行時，最終會跳過行。例如：假設你的行在列A中有數字1 ... 10。你看第一行並決定刪除它。現在你看第二排。它有3號！你從來沒有看過第2排！

更好的方法是過濾電子表格中的列T的標準，複製它，粘貼到新的工作表（格式化等）。

您可以打開宏錄製並手動執行此操作;那麼你將有確切的VBA代碼。我相信這會更快。

即使你，如果你想要做一個for each，你刪除的東西，顛倒順序（末開始，向後工作）

Answer 2

如果你想使用一個循環不這樣做，將以下不應該跳過項目。 我認爲@Floris過濾方法雖然可能會更快。

Sub Main() 
    Dim Row As Long 
    Dim Sheet As Worksheet 
    Row = 5 
    Set Sheet = Worksheets("Sheet1") 
    Application.ScreenUpdating = False 
    Do 
     If Sheet.Cells(Row, 20).Value = 1 Then 
      Sheet.Rows(Row).Delete xlShiftUp 
     Else 
      Row = Row + 1 
     End If 
    Loop While Row <= 900000 
    Application.ScreenUpdating = True 
End Sub 

更新 我切換周圍的環Application.ScreenUpdating，通常加速這樣的東西了很多！

Answer 3

我發現的最快捷的方法是清除行數據（.clear）然後排序。 例如，我想擺脫分頁符，顯示爲「=========」

I=20 
Do While i <= lRow3 
    If Left(Trim(ws3.Cells(i, 1)), 1) = "=" Then 
     ws3.Range(Rows(i - 7), Rows(i + 2)).Clear 
     'i = i - 7 
     'lRow3 = lRow3 - 10 
    End If 
    i = i + 1 
Loop 

現在排序，然後做一個xlUp最後一行（ws3.Range（「A1000000」）的.End（xlUp）.Row）等。

刪除行（在我的其中一個約220,000行的文件中）需要3分鐘。清除內容需要10秒鐘。

然後，如果您需要在完成之前將數據從行下方移動到上面的一個位置，那麼問題就變成了如何「移除」空行。 :)

乾杯， BJ

Answer 4

如果您管理您的數據，如數據庫，並希望刪除特定行了出來，並有可能對其進行過濾，還有一招，以加快您刪除 - 處理。與簡單的循環過程相比，這是非常快的：

我比較了不同示例（4806行）的時間。

• 標準環缺失：2:25
• 範圍缺失：0:20
• 篩選缺失：0點01

例：我在「Tabelle5數據'並且想要刪除特定的行。數據從第6行開始。第1列中以「OLD＃」開頭的每一行都應該被刪除。

1）在此標準溶液（最長時間）：

Dim i As Integer, counter As Integer 
Dim strToRemove As String, strToRemoveRange As String 
strToRemove = "OLD#" 
strToRemoveRange = "" 
counter = 0 

With Tabelle5 
    For i = .UsedRange.Rows.Count To 6 Step -1 
     If Mid(.Cells(i, 1).value, 1, 4) = strToRemove Then 
      .Rows(i).Delete Shift:=xlUp 
     End If 
    Next i 
End With 

2）在這裏，範圍溶液（中間時間）：

Dim i As Integer, counter As Integer 
Dim strToRemove As String, strToRemoveRange As String 
strToRemove = "OLD#" 
strToRemoveRange = "" 
counter = 0 

With Tabelle5 
    For i = .UsedRange.Rows.Count To 6 Step -1 
     If Mid(.Cells(i, 1).value, 1, 4) = strToRemove Then 
      If strToRemoveRange = "" Then 
       strToRemoveRange = CStr(i) & ":" & CStr(i) 
      Else 
       strToRemoveRange = strToRemoveRange & "," & CStr(i) & ":" & CStr(i) 
      End If 
      counter = counter + 1 
     End If 
     If counter Mod 25 = 0 Then 
      If counter > 0 Then 
       .Range(strToRemoveRange).Delete Shift:=xlUp 
       strToRemoveRange = "" 
       counter = 0 
      End If 
     End If 
    Next i 
    If Len(strToRemoveRange) > 0 Then 
     '.Range(strToRemoveRange).Delete Shift:=xlUp 
    End If 
End With 

3）過濾溶液（最短的時間）：

Dim i As Integer, counter As Integer 
Dim strToRemove As String, strToRemoveRange As String 
strToRemove = "OLD#" 
strToRemoveRange = "" 
counter = 0 

With Tabelle5 
    For i = .UsedRange.Rows.Count To 6 Step -1 
     If Mid(.Cells(i, 1).value, 1, 4) = strToRemove Then 
      .Cells(i, 1).Interior.Color = RGB(0, 255, 0) 
      counter = counter + 1 
     End If 
    Next i 
    If counter > 0 Then 
     .Rows("5:5").AutoFilter 
     .AutoFilter.Sort.SortFields.Clear 
     .AutoFilter.Sort.SortFields.Add(_ 
      Range("A5"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, 255, 0) 
     .AutoFilter.Sort.Header = xlYes 
     .AutoFilter.Sort.MatchCase = False 
     .AutoFilter.Sort.Orientation = xlTopToBottom 
     .AutoFilter.Sort.SortMethod = xlPinYin 
     .AutoFilter.Sort.Apply 
     .Rows("6:" & CStr(counter + 5)).Delete Shift:=xlUp 
     .Rows("5:5").AutoFilter 
    End If 
End With 

這裏的綠線將排在最前面，一定範圍的綠色點擊將被整體刪除。這是我知道的最快的方式！ :-)

我希望它能幫助別人！

此致 湯姆