使用VBA删除行的最有效的方法

我目前有一个macros，我用来删除一个logging，如果ID不存在于我从一个XML文档创build的ID列表中。 它的工作方式就像我想要的那样，但是我在电子表格中有超过1000个列（一年中的每一天一个，直到2015年底），因此需要时间来删除行，并且只能在1或2之前“Excel耗尽资源，不得不停止”。 下面是我正在使用的macros的代码，是否有另一种方法，我可以做到这一点，使Excel不运行的资源？

Sub deleteTasks() Application.ScreenUpdating = False Dim search As String Dim sheet As Worksheet Dim cell As Range, col As Range Set sheet = Worksheets("misc") Set col = sheet.Columns(4) ActiveWorkbook.Sheets("Schedule").Activate ActiveSheet.Range("A4").Select ActiveSheet.Unprotect ActiveSheet.Range("A:C").EntireColumn.Hidden = False Do While ActiveCell.Value <> "" search = ActiveCell.Value Set cell = col.Find(What:=search, LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) If cell Is Nothing Then 'If the taskID is not in the XML list Debug.Print "Deleted Task: " & ActiveCell.Value Selection.EntireRow.Delete End If ActiveCell.Offset(1, 0).Select 'Select next task ID Loop ActiveSheet.Range("A:B").EntireColumn.Hidden = True ActiveSheet.Protect End Sub 

尝试了很多不同的选项，包括下面列出的所有答案。 我已经意识到，不pipe是什么方法，删除〜1100列的行将花费我的平均笔记本电脑（2.20 Ghz，4GB的RAM）一段时间。 由于大部分行是空的，我发现替代方法是更快。 我只是清除包含数据（A：S）的单元格，然后调整表格的大小以删除刚删除数据的行。 这最终结果与entireColumn.Delete 。 下面是我现在使用的代码

 'New method - takes about 10 seconds on my laptop Set ws = Worksheets("Schedule") Set table = ws.ListObjects(1) Set r = ws.Range("A280:S280") r.Clear table.Resize Range("A3:VZ279") 

使用任何涉及到EntireColumn.Delete或只是手动select行并删除它需要我的笔记本电脑大约20-30秒。 当然这种方法只适用于你的数据在表中。

Answer 1

简短的回答：

使用类似的东西

 ActiveSheet.Range(DelStr).Delete ' where DelStr = "15:15" if you want to delete row 15 ' = "15:15,20:20,32:32" if you want to delete rows 15,20 and 32 

漫长的回答：

重要提示：如果您有〜30/35行删除，下面的代码非常有效地工作。 除此之外，它会抛出一个错误。 要有效地处理任意数量的行的代码，请看下面这个很长的答案 。

如果你有一个函数让你列出你想要删除的行，请尝试下面的代码。 这是我用来以最小的开销非常有效地删除多行。 （这个例子假设你已经获得了需要通过某个程序删除的行，这里我手动将它们input）：

 Sub DeleteRows() Dim DelRows() As Variant ReDim DelRows(1 To 3) DelRows(1) = 15 DelRows(2) = 18 DelRows(3) = 21 '--- How to delete them all together? Dim i As Long For i = LBound(DelRows) To UBound(DelRows) DelRows(i) = DelRows(i) & ":" & DelRows(i) Next i Dim DelStr As String DelStr = Join(DelRows, ",") ' DelStr = "15:15,18:18,21:21" ' ' IMPORTANT: Range strings have a 255 character limit ' See the other code to handle very long strings ActiveSheet.Range(DelStr).Delete End Sub 

针对任意行数和基准结果的（非常长）高效解决scheme：

以下是通过删除行获得的基准testing结果（以秒为单位而不是以行为单位的时间）。

行在干净的工作表上，并在D1：D100000的D列中包含易失性公式

即对于100,000行，它们具有公式=SIN(RAND())

代码很长，不太漂亮，但它将DelStr分割成250个字符的子串，并使用这些子串形成一个范围。 然后在一个操作中删除新的DeleteRng范围。

删除的时间可能取决于单元格的内容。 testing/基准testing，与一点直觉相吻合，表明了以下结果。

• 稀疏行/空单元格删除速度最快
• 值的单元格需要更长的时间
• 具有配方的细胞需要更长时间
• input到其他单元格中的单元格的时间最长，因为它们的删除会触发#Ref参考错误。

码：

 Sub DeleteRows() ' Usual optimization ' Events not disabled as sometimes you'll need to interrupt ' You can optionally keep them disabled Application.Calculation = xlCalculationManual Application.ScreenUpdating = False ' Declarations... Dim DelRows() As Variant Dim DelStr As String, LenStr As Long Dim CutHere_Str As String Dim i As Long Dim MaxRowsTest As Long MaxRowsTest = 1000 ' Here I'm taking all even rows from 1 to MaxRowsTest ' as rows to be deleted ReDim DelRows(1 To MaxRowsTest) For i = 1 To MaxRowsTest DelRows(i) = i * 2 Next i '--- How to delete them all together? LenStr = 0 DelStr = "" For i = LBound(DelRows) To UBound(DelRows) LenStr = LenStr + Len(DelRows(i)) * 2 + 2 ' One for a comma, one for the colon and the rest for the row number ' The goal is to create a string like ' DelStr = "15:15,18:18,21:21" If LenStr > 200 Then LenStr = 0 CutHere_Str = "!" ' Demarcator for long strings Else CutHere_Str = "" End If DelRows(i) = DelRows(i) & ":" & DelRows(i) & CutHere_Str Next i DelStr = Join(DelRows, ",") Dim DelStr_Cut() As String DelStr_Cut = Split(DelStr, "!,") ' Each DelStr_Cut(#) string has a usable string Dim DeleteRng As Range Set DeleteRng = ActiveSheet.Range(DelStr_Cut(0)) For i = LBound(DelStr_Cut) + 1 To UBound(DelStr_Cut) Set DeleteRng = Union(DeleteRng, ActiveSheet.Range(DelStr_Cut(i))) Next i DeleteRng.Delete Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub 

生成公式在空白表中的代码是

 Sub FillRandom() ActiveSheet.Range("D1").FormulaR1C1 = "=SIN(RAND())" Range("D1").AutoFill Destination:=Range("D1:D100000"), Type:=xlFillDefault End Sub 

而上面生成基准testing结果的代码是

 Sub TestTimeForDeletion() Call FillRandom Dim Time1 As Single, Time2 As Single Time1 = Timer Call DeleteRows Time2 = Timer MsgBox (Time2 - Time1) End Sub 

注意：非常感谢brettdj指出DelStr长度超过255个字符时抛出的错误。 这似乎是一个已知的问题，而我痛苦地发现，它仍然存在Excel 2013。

Answer 2

这段代码使用AutoFilter，比循环行要快得多。

我每天都用，应该很容易搞清楚。

只要通过它你要找的东西和列search。

如果需要，也可以对列进行硬编码。

 private sub PurgeRandy Call FindDelete("F", "Randy") end sub 

 Public Sub FindDelete(sCOL As String, vSearch As Variant) 'Simple find and Delete Dim lLastRow As Integer Dim rng As Range Dim rngDelete As Range Range(sCOL & 1).Select [2:2].Insert [2:2] = "***" Range(sCOL & ":" & sCOL).Select With ActiveSheet .UsedRange lLastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row Set rng = Range(sCOL & 2, Cells(lLastRow, sCOL)) rng.AutoFilter Field:=1, Criteria1:=vSearch Set rngDelete = rng.SpecialCells(xlCellTypeVisible) rng.AutoFilter rngDelete.EntireRow.Delete .UsedRange End With End Sub 

Answer 3

在这种情况下，可以使用一个简单的工作公式来查看您的testing范围内的每个值（ 计划的 A列）是否存在于misc的 F列

在B4它=MATCH(A4,misc!D:D,0)

这可以手动使用，也可以使用代码进行高效的删除，因为如果没有匹配，我们可以使用以下任一方法通过VBA有效地删除匹配的公式：

• AutoFilter
• SpecialCells （ devise作品*）

在xl2007中注意，可以用SpecialCellsselect8192个离散区域的限制

码

 Sub ReCut() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim rng1 As Range Set ws1 = Sheets("misc") Set ws2 = Sheets("schedule") With Application .ScreenUpdating = False .EnableEvents = False .DisplayAlerts = False End With Set rng1 = ws2.Range(ws2.[a4], ws2.Cells(Rows.Count, "A").End(xlUp)) ws2.Columns(2).Insert With rng1.Offset(0, 1) .FormulaR1C1 = "=MATCH(RC[-1],'" & ws1.Name & "'!C[2],0)" On Error Resume Next .Cells.SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete On Error GoTo 0 End With ws2.Columns(2).Delete With Application .ScreenUpdating = True .EnableEvents = True .DisplayAlerts = True End With End Sub 

Answer 4

注意：我没有足够的“声誉”来添加我的评论，因此张贴为答案。 贷款给精彩的答案（长答）。 我有一个编辑build议：

一旦你分割长string，并在最后一个块超过设置字符，那么它是“！” 在范围方法抛出错误的最后。 IF语句和MID的添加确保了不存在这样的字符。

要处理这个问题，请使用：

 For i = LBound(DelStr_Cut) + 1 To UBound(DelStr_Cut) If Right(DelStr_Cut(i), 1) = "!" Then DelStr_Cut(i) = Mid(DelStr_Cut(i), 1, Len(DelStr_Cut(i)) - 1) Set DeleteRng = Union(DeleteRng, ActiveSheet.Range(DelStr_Cut(i))) Else Set DeleteRng = Union(DeleteRng, ActiveSheet.Range(DelStr_Cut(i))) End If Next i 

谢谢你，巴库尔