在条件上删除整行不能处理400,000行
我有这个macros来删除那些不是“chr9”的整个行。 我总共有401,094行。 它似乎编译好，但我的Excel冻结，我必须强制退出。
我认为这可能是一个低效率的algorithm，或者可能是代码中的错误？
Sub deleteNonChr9() Dim lastrow As Long Dim firstrow As Long Dim i As Long lastrow = 401094 firstrow = 0 ' Increment bottom of sheet to upwards For i = lastrow To firstrow Step -1 If (Range("C1").Offset(i, 0) <> "chr9") Then Range("C1").Offset(i, 0).EntireRow.Delete End If Next i End Sub 有条件删除行的最快方法是将它们全部放在数据块的底部。 将它们sorting到这个位置并删除比单独的循环更快，甚至编译不连续的行来删除。
当任何组或单元格是连续的（即所有在一起）Excel不需要努力摆脱他们。 如果它们位于Worksheet.UsedRange属性的底部，则Excel不必计算用来填充空白空间的内容。
您的原始代码不允许第1行的列标题文本标签，但我会说明这一点。 修改以适应，如果你没有一个。
这些将closures计算能力的三个主要寄生虫。 在注释和回答中已经解决了两个问题，第三个Application.EnableEvents属性也可以对Sub过程效率做出有效的贡献，无论您是否具有事件驱动例程。 有关详细信息，请参阅底部的帮助程序Sub程序。
采样数据2：A：Z中的500K行随机数据。 C栏中Chr9 ％ Chr9 ：C。 大约333K随机不连续行删除。
联合和删除
Option Explicit Sub deleteByUnion() Dim rw As Long, dels As Range On Error GoTo bm_Safe_Exit appTGGL bTGGL:=False 'disable parasitic environment With Worksheets("Sheet1") Set dels = .Cells(.Rows.Count, "C").End(xlUp).Offset(1) For rw = .Cells(.Rows.Count, "C").End(xlUp).Row To 2 Step -1 If LCase$(.Cells(rw, "C").Value2) <> "chr9" Then Set dels = Union(dels, .Cells(rw, "C")) End If Next rw If Not dels Is Nothing Then dels.EntireRow.Delete End If End With bm_Safe_Exit: appTGGL End Sub
已经过的时间： <已经20分钟了…当它结束时我会更新…>
从工作表批量加载到variables数组，更改，加载回来，sorting和删除
Sub deleteByArrayAndSort() Dim v As Long, vals As Variant On Error GoTo bm_Safe_Exit appTGGL bTGGL:=False 'disable parasitic environment With Worksheets("Sheet1") With .Cells(1, 1).CurrentRegion .EntireRow.Hidden = False With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0) 'bulk load column C values vals = .Columns(3).Value2 'change non-Chr9 values into vbNullStrings For v = LBound(vals, 1) To UBound(vals, 1) If LCase$(vals(v, 1)) <> "chr9" Then _ vals(v, 1) = vbNullString Next v End With 'dump revised array back into column C .Cells(2, "C").Resize(UBound(vals, 1), UBound(vals, 2)) = vals 'sort all of blank C's to the bottom .Cells.Sort Key1:=.Columns(3), Order1:=xlAscending, _ Orientation:=xlTopToBottom, Header:=xlYes 'delete non-Chr9 contiguous rows at bottom of currentregion .Range(.Cells(.Rows.Count, "C").End(xlUp), .Cells(.Rows.Count, "C")).EntireRow.Delete End With .UsedRange 'reset the last_cell property End With bm_Safe_Exit: appTGGL End Sub
已用时间：11.61秒¹
（166,262行数据剩余2）
原始代码
经过时间： <仍在等待…>
概要
在variables数组中工作以及删除连续的范围有明显的优势。 我的示例数据有约66％的行要删除，所以这是一个苛刻的任务主。 如果有5或20行删除，使用数组来parsing数据可能不是最好的解决scheme。 你将不得不根据你自己的数据做出自己的决定。
appTGGL帮手子程序
Public Sub appTGGL(Optional bTGGL As Boolean = True) With Application .ScreenUpdating = bTGGL .EnableEvents = bTGGL .Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual) End With Debug.Print Timer End Sub
¹ 环境：运行WIN7和Office 2013（15.0.4805.1001 MSO 15.0.4815.1000 32位版本）的移动i5和8gbs DRAM的老式商用笔记本电脑 – 执行此级别过程的典型低端规模。
² 在删除整行时暂时可用的样本数据不能处理400,000 rows.xlsb 。
切换ScreenUpdating和计算将有所帮助。 但正如Jeeped所说，应用自定义sorting顺序是一条路。
Sub deleteNonChr9() Dim lastrow As Long Dim firstrow As Long Dim i As Long lastrow = 401094 firstrow = 1 Application.ScreenUpdating = False Application.Calculation = xlCalculationManual ' Increment bottom of sheet to upwards For i = lastrow To firstrow Step -1 If (Cells(i, "C") <> "chr9") Then Rows(i).EntireRow.Delete End If Next i Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub
主要进展
以下处理删除大量行的代码是由Ron de Bruin – Excel自动化启发的。
Sub QuickDeleteRows() Dim Sheet_Data As Worksheet, NewSheet_Data As Worksheet Dim Sheet_Name As String, ZeroTime As Double, Data As Range On Error GoTo Error_Handler SpeedUp True Set Sheet_Data = Sheets("Test") Sheet_Name = Sheet_Data.Name LastRow = Cells(Rows.Count, "A").End(xlUp).Row LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column Set Data = Sheet_Data.Range("A1", Cells(LastRow, LastColumn)) Set NewSheet_Data = Sheets.Add(After:=Sheet_Data) Data.AutoFilter Field:=3, Criteria1:="=Chr9" Data.Copy With NewSheet_Data.Cells .PasteSpecial xlPasteColumnWidths .PasteSpecial xlPasteAll .Cells(1, 1).Select .Cells(1, 1).Copy End With Sheet_Data.Delete NewSheet_Data.Name = Sheet_Name Safe_Exit: SpeedUp False Exit Sub Error_Handler: Resume Safe_Exit End Sub Sub SpeedUp(SpeedUpOn As Boolean) With Application If SpeedUpOn Then .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual .DisplayStatusBar = False .DisplayAlerts = False Else .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic .DisplayStatusBar = True .DisplayAlerts = True End If End With End Sub
虽然我旧版本的代码在处理由Jeeped提供的样本数据上花费了相当长的时间（平均约130秒），但是上面的代码在我的机器上处理了400,000行样本数据的时间less于4.6秒 。 这是一个非常显着的performance！
我的电脑的系统信息 （学生的最低电脑configuration）
- 操作系统： Windows 7 Professional 32位（6.1，Build 7601）Service Pack 1
- 系统制造商： Hewlett-Packard
- 系统型号： HP Pro 3330 MT
- 处理器： Intel（R）Core（TM）i3-2120 CPU @ 3.30GHz（4 CPU），〜3.3GHz
- 内存： 2048MB RAM
原始答复
我知道这个答案并不是OP所要的，但也许这个答案对其他用户很有用，对未来的用户也是有用的，如果不是OP的话。 请看这个答案作为替代方法。
在Excel中复制/粘贴 ， 剪切/插入和删除整行操作可能会花费过长的时间。 对于复制/粘贴和剪切/插入操作，缓慢的原因是数据本身的格式化。 内存过度分配是这些操作的另一个原因。 那么我们如何解决这样的情况呢？ 有几件事你可以寻找加快你的代码。
- 使用数组而不是单元格的范围。 通常认为它比在单元格范围内工作更快，因为它忽略单元格中数据的格式。
- 使用
.Value2而不是默认的属性（.Value），因为.Value2只会将所有的格式化数字（货币，会计，date，科学等）都视为双精度。
假设我们有10,000行虚拟数据，如下面的数据集：
而不是删除整个“non-chr9”数据行，我只是忽略这些数据，只考虑“chr9”数据通过复制所有“chr9”数据到一个数组。 如何编码来执行这样的任务？ 首先，我们必须复制数据以避免数据丢失，因为运行VBA Excel后无法撤消所有更改以恢复原始数据。
看来你已经完成了所有需要的准备工作。 现在，我们可以开始编码，首先将我们需要的每个variables都声明为适当types的数据。
Dim i As Long, j As Long, k As Long Dim LastRow As Long, LastColumn As Long, LengthDataChr9 As Long
如果你不声明variables，你的代码将会运行那些默认为Varianttypes的variables。 虽然Variant可以非常有用，但它可以使你的代码变慢。 所以，确保每个variables都用一个合理的types声明。 这是很好的编程习惯，速度也相当快。
接下来，我们确定所有将用来构造数组大小的variables。 我们会需要
LastRow = Cells(Rows.Count, "A").End(xlUp).Row LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
LastRow和LastColumn是数据在一行或一列中的最后一个单元格的行号和列号。 请记住，如果您没有正确设置或使用格式良好的数据表， LastRow和LastColumn可能不会给您所需的行和列号。 我的意思是“格式良好的数据表”是一个工作表，其中数据以单元格A1开始，列A中的行数和列1中的列数必须等于所有数据的范围。 换句话说，所有数据范围的大小必须等于LastRow x LastColumn 。
我们还需要数组的长度来存储所有的“chr9”数据。 这可以通过使用以下语句对所有“chr9”数据进行计数来完成：
LengthDataChr9 = Application.CountIf(Columns("C"), "chr9")
我们现在知道数组的大小，我们可以重新调整它的大小。 添加下面的代码行：
ReDim Data(1 To LastRow, 1 To LastColumn) ReDim DataChr9(1 To LengthDataChr9, 1 To LastColumn)
我们使用ReDim而不是Dim因为我们使用dynamic数组。 VBA Excel 自动将数组声明为Varianttypes，但是它们还没有大小。 接下来，我们通过使用语句将数据复制到数组Data
Data = Range("A1", Cells(LastRow, LastColumn)).Value2
我们使用.Value2来提高代码的性能（参见上面加速提示点2）。 由于数据已经复制到数组Data我们可以清除工作表数据，所以我们可以使用它来粘贴DataChr9 。
Rows("1:" & Rows.Count).ClearContents
要清除工作表上的所有内容（所有内容，格式等），我们可以使用Sheets("Sheet1").Cells.Clear或Sheet1.Cells.Clear 。 接下来，我们希望代码通过使用For … Next语句遍历第3列中的元素数组Data ，因为我们要查找的所需数据位于此处。 如果Data数组中的元素包含string“chr9”，代码会将“chr9”所在行的所有元素复制到DataChr9 。 我们再次使用For … Next语句。 以下是执行这些程序的路线。
For i = 1 To UBound(Data) If Data(i, 3) = "chr9" Then j = j + 1 For k = 1 To LastColumn DataChr9(j, k) = Data(i, k) Next k End If Next i
其中j = j + 1是循环DataChr9行的DataChr9 。 最后一步，我们将DataChr9所有元素粘贴回工作表，方法是在代码中添加这一行：
Range("A1", Cells(LengthDataChr9, LastColumn)) = DataChr9
然后你就完成了！ 耶，终于！
好的，让我们编译上面的所有行代码。 我们获得
Sub DeleteNonChr9() Dim i As Long, j As Long, k As Long Dim LastRow As Long, LastColumn As Long, LengthDataChr9 As Long LastRow = Cells(Rows.Count, "A").End(xlUp).Row LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column LengthDataChr9 = Application.CountIf(Columns("C"), "chr9") ReDim Data(1 To LastRow, 1 To LastColumn) ReDim DataChr9(1 To LengthDataChr9, 1 To LastColumn) Data = Range("A1", Cells(LastRow, LastColumn)).Value2 Rows("1:" & Rows.Count).ClearContents For i = 1 To UBound(Data) If Data(i, 3) = "chr9" Then j = j + 1 For k = 1 To LastColumn DataChr9(j, k) = Data(i, k) Next k End If Next i Range("A1", Cells(LengthDataChr9, LastColumn)) = DataChr9 End Sub
以上代码的性能令人满意。 完成从我的机器上的10,000行伪数据中提取所有“chr9”数据的过程平均需要不到0.5秒的时间。