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 

这里的绿线将排在最前面，一定范围的绿色点击将被整体删除。这是我知道的最快的方式！ :-)

我希望它能帮助别人！

此致 汤姆