更快的代码，通过Excel中的多个工作表删除单元格

我是一个初学者在VB中，并已谷歌search，并在这里查看答案我已经写了以下循环来循环通过多个Excel工作表，并删除单元格包含特定元素（N / A＃N / A＃）的行。

要清理的xl表中的数据是具有DATE，OPEN的财务数据。 高低closures。 行数可以是显着的，工作表的数量可以是2-300。 它的工作，但是非常非常缓慢，我正在学习 – 将不胜感激任何帮助我如何使这个代码更快。 谢谢。

Sub DataDeleteStage1() ScreenUpdating = False Dim lrow As Long Dim ws As Worksheet Dim icntr As Long For Each ws In ThisWorkbook.Worksheets lrow = ws.Cells(Rows.CountLarge, "a").End(xlUp).Row For icntr = lrow To 1 Step -1 If ws.Name <> "HEADER" Then If ws.Cells(icntr, "B") = "#N/AN/A" And ws.Cells(icntr, "C") = "#N/AN/A" And ws.Cells(icntr, "D") = "#N/AN/A" And ws.Cells(icntr, "E") = "#N/AN/A" Then ws.Rows(icntr).EntireRow.Delete End If End If Next icntr Next ws End Sub 

Answer 1

尝试将所有要删除的Range合并到一个MergeRng对象中，然后将其全部删除。

码

 Sub DataDeleteStage1() ScreenUpdating = False Dim lrow As Long Dim ws As Worksheet Dim icntr As Long Dim MergeRng As Range For Each ws In ThisWorkbook.Worksheets With ws lrow = .Cells(.Rows.Count, "A").End(xlUp).Row For icntr = lrow To 1 Step -1 If .Name <> "HEADER" Then If .Cells(icntr, "B") = "#N/AN/A" And .Cells(icntr, "C") = "#N/AN/A" And .Cells(icntr, "D") = "#N/AN/A" And .Cells(icntr, "E") = "#N/AN/A" Then If Not MergeRng Is Nothing Then Set MergeRng = Application.Union(MergeRng, .Rows(icntr)) Else Set MergeRng = .Rows(icntr) End If End If End If Next icntr ' Delete all rows at once If Not MergeRng Is Nothing Then MergeRng.Delete End With Set MergeRng = Nothing ' reset range when changing worksheets Next ws End Sub 

Answer 2

你可以让你的代码只删除一次，而不是每次都删除。 为了做到这一点，请尝试以下操作：

 Sub DataDeleteStage1() Application.ScreenUpdating = False Dim lrow As Long Dim ws As Worksheet Dim icntr As Long Dim delRange As Range For Each ws In ThisWorkbook.Worksheets lrow = ws.Cells(Rows.CountLarge, "a").End(xlUp).Row For icntr = lrow To 1 Step -1 If ws.Name <> "HEADER" Then If ws.Cells(icntr, "B") = "#N/AN/A" And _ ws.Cells(icntr, "C") = "#N/AN/A" And _ ws.Cells(icntr, "D") = "#N/AN/A" And _ ws.Cells(icntr, "E") = "#N/AN/A" Then If Not delRange Is Nothing Then Set delRange = ws.Rows(icntr) Else Set delRange = Union(delRange, ws.Rows(icntr)) End If End If End If Next icntr If Not delRange Is Nothing Then delRange.Delete Set delRange = Nothing Next ws End Sub 

我没有尝试过，但它应该工作。

Answer 3

这个怎么样？

 Sub DeleteRows() Dim ws As Worksheet With Application .Calculation = xlCalculationManual .EnableEvents = False .ScreenUpdating = False End With For Each ws In ThisWorkbook.Sheets If ws.Name <> "HEADER" Then On Error Resume Next ws.Columns("B:E").Replace "#N/AN/A", "=NA()" ws.Columns("B:E").SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete End If Next ws With Application .Calculation = xlCalculationAutomatic .EnableEvents = True .ScreenUpdating = True End With End Sub 

Answer 4

使用AutoFilter并且不需要循环：

 Sub DataDeleteStage1() Dim ws As Worksheet Dim lr As Integer Application.ScreenUpdating = False For Each ws In ThisWorkbook.Worksheets With ws lr = .Range("A" & .Rows.Count).End(xlUp).Row If ws.Name <> "HEADER" Then .UsedRange.AutoFilter Field:=2, Criteria1:="#N/A" .UsedRange.AutoFilter Field:=3, Criteria1:="#N/A" .UsedRange.AutoFilter Field:=4, Criteria1:="#N/A" .UsedRange.AutoFilter Field:=5, Criteria1:="#N/A" .Range("A2:A" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Delete shift:=xlUp End If End With Next ws Application.ScreenUpdating = True End Sub 

testing这个与300K行的合并范围方法相比 – 在多个工作表上，分钟更快。

Answer 5

我没有testing，但试试这个，

 Sub DataDeleteStage1() Application.ScreenUpdating = False Application.DisplayAlerts = False Dim lrow As Long Dim ws As Worksheet Dim icntr As Long For Each ws In ThisWorkbook.Worksheets lrow = ws.Cells(Rows.CountLarge, "a").End(xlUp).Row If ws.Name <> "HEADER" Then On Error Resume Next Range("F1:F" & lrow).Formula = "=IF(SUMPRODUCT(--ISERROR(A1:E1))=5,NA(),"""")" Range("F1:F" & lrow).SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete shift:=xlUp Range("F1:F" & lrow).Clear End If Next ws Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub