如何更改我的代码以更快速地运行它？

我有一个170K行的工作簿，当单元格之间的结果为0时，我将删除所有的行，
对于那些操作，通常我使用下面的代码，但是与170K（行将被删除是90K）代码运行非常缓慢。
有人知道另一种方式更多的performance。 谢谢

Last = Cells(Rows.Count, "K").End(xlUp).Row For i = Last To 2 Step -1 If (Cells(i, "K").Value + Cells(i, "L").Value) < 1 Then Cells(i, "A").EntireRow.Delete End If Next i 

Answer 1

只要你把数据放在一个新的选项卡上，下面的代码将在1.5秒内完成你所需要的一切。

 Sub ExtractRows() Dim vDataTable As Variant Dim vNewDataTable As Variant Dim vHeaders As Variant Dim lastRow As Long Dim i As Long, j As Long Dim Counter1 As Long, Counter2 As Long With Worksheets(1) lastRow = .Cells(Rows.Count, "K").End(xlUp).row vHeaders = .Range("A1:L1").Value2 vDataTable = .Range("A2:L" & lastRow).Value2 End With For i = 1 To UBound(vDataTable) If vDataTable(i, 11) + vDataTable(i, 12) > 0 Then Counter1 = Counter1 + 1 End If Next ReDim vNewDataTable(1 To Counter1, 1 To 12) For i = 1 To UBound(vDataTable) If vDataTable(i, 11) + vDataTable(i, 12) > 0 Then Counter2 = Counter2 + 1 For j = 1 To 12 vNewDataTable(Counter2, j) = vDataTable(i, j) Next j End If Next Worksheets.Add After:=Worksheets(1) With Worksheets(2) .Range("A1:L1") = vHeaders .Range("A2:L" & Counter1 + 1) = vNewDataTable End With End Sub 

Answer 2

在这里，我根据rwilson的想法来处理你的问题。

我已经testing过了。 这非常减less执行时间。 尝试一下。

 Sub deleteRow() Dim newSheet As Worksheet Dim lastRow, newRow As Long Dim sheetname As String Dim startTime As Double sheetname = "sheetname" With Sheets(sheetname) Set newSheet = ThisWorkbook.Worksheets.Add(After:=Sheets(.Name)) 'Firstly copy header newSheet.Rows(1).EntireRow.Value = .Rows(1).EntireRow.Value lastRow = .Cells(.Rows.Count, "K").End(xlUp).row newRow = 2 For row = 2 To lastRow Step 1 If (.Cells(row, "K").Value + .Cells(row, "L").Value) >= 1 Then newSheet.Rows(newRow).EntireRow.Value = .Rows(row).EntireRow.Value newRow = newRow + 1 End If Next row End With Application.DisplayAlerts = False Sheets(sheetname).Delete Application.DisplayAlerts = True newSheet.Name = sheetname End Sub 

Answer 3

这是一个非VBA选项，你可以尝试：

1. 在列M中计算列K和L的总和
2. 突出显示列M并单击Find and select > Find
3. 在“ Find what框中键入0 ，并在“ Find what框中selectvalues
4. selectFind all然后在显示find的项目的方框中select所有条目（单击该框并按CTRL + A ）
5. 在function区上selectDelete ，然后selectDelete sheet rows
6. 现在手动删除列M

我还没有尝试过170k +行，但也许值得评估与VBA循环的性能。

Answer 4

感谢所有的想法，但真正快速的代码是：
使用一个数组tu填充正确的date并重新整理所有的表格sorting表：

 Sub Macro13(control As IRibbonControl) Dim avvio As Date Dim arresto As Date Dim tempo As Date Application.ScreenUpdating = False Application.Calculation = xlManual avvio = Now() Dim sh As Worksheet Dim arng As Variant Dim arrdb As Variant Dim UR As Long, x As Long, y As Long Dim MyCol As Integer Set sh = Sheets("Rol_db") MyCol = 1 sh.Select UR = sh.Cells(Rows.Count, MyCol).End(xlUp).Row ReDim arrdb(2 To UR, 1 To 12) As Variant For x = 2 To UR If Cells(x, 11) + Cells(x, 12) > 0 Then For y = 1 To 12 arrdb(x, y) = Cells(x, y) Next y Else For y = 1 To 12 arrdb(x, y) = "" Next y End If Next x sh.Range("A2:L" & UR) = arrdb arresto = Now() tempo = arresto - avvio Debug.Print "Delete empty rows " & tempo Range("A2:L" & UR).Sort key1:=Range("A2:L" & UR), _ order1:=xlAscending, Header:=xlNo Range("A4").Select ActiveWindow.FreezePanes = True conclusioni: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub 

时间为我的工作表170K 00:00:07。 只要我有一分钟，我感觉到一个列的循环