根据条件删除整行无法处理 400,000 行
Deleting entire row on criteria cannot handle 400,000 rows
我有这个宏来删除那些不是 "chr9" 的整行。我总共有 401,094 行。似乎编译正常，但我的 Excel 冻结了，我不得不强制退出。
我认为这可能是一个低效的算法或者代码中的一些错误？
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
切换屏幕更新和计算会有所帮助。但正如 Jeeped 所说，应用自定义排序顺序是可行的方法。
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
有条件地删除行的最快方法是将它们全部放在数据块的底部。将它们排序到那个位置并删除比单独循环甚至编译不连续的 Union 行要删除更快。
当任何组或单元格是连续的（即全部在一起）时 Excel 不必那么努力地摆脱它们。如果它们在 Worksheet.UsedRange property 的底部，Excel 就不必计算用什么来填充空的 space。
您的原始代码不允许在第 1 行中使用 header 列文本标签，但我会考虑到这一点。如果您没有，请修改以适应。
这些将关闭计算能力的三个主要寄生虫。其中两个已经在评论和答案中得到解决，第三个 Application.EnableEvents property 也可以对 Sub 过程效率做出有效贡献，无论您是否有事件驱动例程。详情见底部的辅助 Sub 程序。
示例数据²：A:Z 中的 500K 行随机数据。 ~33% Chr9 在列 C:C 中。要删除大约 333K 随机不连续的行。
Union 并删除
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
Elapsed time: <It has been 20 minutes... I'll update this when it finishes...>
从工作表批量加载到变体数组、更改、加载回、排序和删除
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
Elapsed time: 11.61 seconds¹
(166,262 rows of data remaining²)
原码
Elapsed time: <still waiting...>
总结
在变体数组中工作以及删除连续范围有明显的优势。我的示例数据有大约 66% 的行要删除，因此它是一项艰巨的任务。如果要删除 5 或 20 行，使用数组解析数据进行排序可能不是最佳解决方案。您将不得不根据自己的数据做出自己的决定。
appTGGL helper 子程序
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
¹ 环境：旧业务 class 配备移动 i5 和 8gbs DRAM 的笔记本电脑 运行 WIN7 和 Office 2013（版本 15.0.4805.1001 MSO 15.0.4815.1000 32 位) - 执行此级别程序的典型低端规模。
² 示例数据暂时可用 Deleting entire row cannot handle 400,000 rows.xlsb。
主要进展
以下处理删除大量行的代码受到Ron de Bruin - Excel Automation.
的启发
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
虽然我的旧版本代码处理 sample data provided by Jeeped 需要相当长的时间（平均约 130 秒），但上面的代码完成不到 4.6 秒在我的机器上处理 400,000 行示例数据。这是一个非常显着的性能提升！
我电脑的系统信息（学生电脑最低配置）
- 操作系统： Windows 7 Professional 32 位（6.1，Build 7601）
服务包 1
- 系统制造商： 惠普
- 系统型号： HP Pro 3330 MT
- 处理器： Intel(R) Core(TM) i3-2120 CPU @ 3.30GHz (4
CPUs), ~3.3GHz
- 内存： 2048MB 内存
原答案
我知道这个答案并不是 OP 真正想要的，但也许这个答案对其他用户有用，对未来的用户有帮助，如果不是 OP。请将此答案视为替代方法。
Copy/paste, cut/insert, 删除整个即使在 VBA Excel 中进行行操作，Excel 中的行操作也会花费很长时间。对于 copy/paste 和 cut/insert 操作，缓慢的原因是数据本身的格式。内存过度分配是这些操作的另一个原因。那么我们如何解决这样的情况呢？您可以通过多种方式来加快代码速度。
- 使用数组而不是单元格区域。它通常被认为比处理单元格范围更快，因为它忽略了单元格中数据的格式。
- 使用
.Value2 而不是默认的 属性 (.Value) 因为 .Value2 只会处理所有格式数字（货币、会计、日期、科学等）作为双打。
假设我们有 10,000 行虚拟数据，如以下数据集：
我没有删除整行 "non-chr9" 数据，而是忽略了这些数据，并通过将所有 "chr9" 数据复制到数组中来仅考虑 "chr9" 数据。如何编写代码来实现这样的任务？首先，我们必须复制我们的数据以避免数据丢失，因为我们不能撤销在 运行ning VBA Excel.
之后恢复原始数据的所有更改
看来你已经做好了所有需要的准备工作。现在，我们可以通过首先将我们需要的每个变量声明为适当类型的数据来开始编码。
Dim i As Long, j As Long, k As Long
Dim LastRow As Long, LastColumn As Long, LengthDataChr9 As Long
如果您不声明变量，您的代码将 运行 这些变量默认为 Variant 类型。虽然 Variant 非常有用，但它会使您的代码变慢。因此，请确保每个变量都以合理的类型声明。这是良好的编程习惯，而且速度要快得多。
接下来，我们确定将用于构造数组大小的所有变量。我们需要
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
LastRow和LastColumn是一行或一列中最后一个有数据的单元格的行号和列号。请记住，如果您未正确设置 LastRow 和 LastColumn 或未使用格式正确的数据 sheet，则它们可能无法为您提供所需的行号和列号。我所说的 "well-formatted data sheet" 是指工作sheet，数据从单元格 A1 开始，A 列中的行数和第 1 行中的列数必须等于所有数据的范围。也就是说，所有数据的范围大小必须等于LastRowxLastColumn.
我们还需要数组的长度来存储所有"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 因为我们使用动态数组。 VBA Excel 自动声明 数组默认为 Variant 类型，但它们还没有大小。接下来，我们使用语句
将数据复制到数组Data中
Data = Range("A1", Cells(LastRow, LastColumn)).Value2
我们使用.Value2来提高代码的性能（见上面的提速技巧第2点）。由于数据已经复制到数组 Data 我们可以清除工作 sheet 数据以便我们可以使用它来粘贴 DataChr9.
Rows("1:" & Rows.Count).ClearContents
要清除作品所有（所有内容、格式等）sheet，我们可以使用Sheets("Sheet1").Cells.Clear或Sheet1.Cells.Clear .接下来，我们希望代码使用 For ... Next 语句循环遍历第 3 列中的元素数组 Data，因为我们要查找的所需数据位于此处.如果找到数组Data的元素包含字符串"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 的所有元素粘贴回 worksheet，方法是在代码中添加以下行：
Range("A1", Cells(LengthDataChr9, LastColumn)) = DataChr9
然后你就完成了！ 耶，终于来了！
OK，让我们编译上面的所有行代码。我们得到
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 秒。
我有这个宏来删除那些不是 "chr9" 的整行。我总共有 401,094 行。似乎编译正常，但我的 Excel 冻结了，我不得不强制退出。
我认为这可能是一个低效的算法或者代码中的一些错误？
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
切换屏幕更新和计算会有所帮助。但正如 Jeeped 所说，应用自定义排序顺序是可行的方法。
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
有条件地删除行的最快方法是将它们全部放在数据块的底部。将它们排序到那个位置并删除比单独循环甚至编译不连续的 Union 行要删除更快。
当任何组或单元格是连续的（即全部在一起）时 Excel 不必那么努力地摆脱它们。如果它们在 Worksheet.UsedRange property 的底部，Excel 就不必计算用什么来填充空的 space。
您的原始代码不允许在第 1 行中使用 header 列文本标签，但我会考虑到这一点。如果您没有，请修改以适应。
这些将关闭计算能力的三个主要寄生虫。其中两个已经在评论和答案中得到解决，第三个 Application.EnableEvents property 也可以对 Sub 过程效率做出有效贡献，无论您是否有事件驱动例程。详情见底部的辅助 Sub 程序。
示例数据²：A:Z 中的 500K 行随机数据。 ~33% Chr9 在列 C:C 中。要删除大约 333K 随机不连续的行。
Union 并删除
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
Elapsed time: <It has been 20 minutes... I'll update this when it finishes...>
从工作表批量加载到变体数组、更改、加载回、排序和删除
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
Elapsed time: 11.61 seconds¹
(166,262 rows of data remaining²)
原码
Elapsed time: <still waiting...>
总结
在变体数组中工作以及删除连续范围有明显的优势。我的示例数据有大约 66% 的行要删除，因此它是一项艰巨的任务。如果要删除 5 或 20 行，使用数组解析数据进行排序可能不是最佳解决方案。您将不得不根据自己的数据做出自己的决定。
appTGGL helper 子程序
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
¹ 环境：旧业务 class 配备移动 i5 和 8gbs DRAM 的笔记本电脑 运行 WIN7 和 Office 2013（版本 15.0.4805.1001 MSO 15.0.4815.1000 32 位) - 执行此级别程序的典型低端规模。
² 示例数据暂时可用 Deleting entire row cannot handle 400,000 rows.xlsb。
主要进展
以下处理删除大量行的代码受到Ron de Bruin - Excel Automation.
的启发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
虽然我的旧版本代码处理 sample data provided by Jeeped 需要相当长的时间（平均约 130 秒），但上面的代码完成不到 4.6 秒在我的机器上处理 400,000 行示例数据。这是一个非常显着的性能提升！
我电脑的系统信息（学生电脑最低配置）
- 操作系统： Windows 7 Professional 32 位（6.1，Build 7601） 服务包 1
- 系统制造商： 惠普
- 系统型号： HP Pro 3330 MT
- 处理器： Intel(R) Core(TM) i3-2120 CPU @ 3.30GHz (4 CPUs), ~3.3GHz
- 内存： 2048MB 内存
原答案
我知道这个答案并不是 OP 真正想要的，但也许这个答案对其他用户有用，对未来的用户有帮助，如果不是 OP。请将此答案视为替代方法。
Copy/paste, cut/insert, 删除整个即使在 VBA Excel 中进行行操作，Excel 中的行操作也会花费很长时间。对于 copy/paste 和 cut/insert 操作，缓慢的原因是数据本身的格式。内存过度分配是这些操作的另一个原因。那么我们如何解决这样的情况呢？您可以通过多种方式来加快代码速度。
- 使用数组而不是单元格区域。它通常被认为比处理单元格范围更快，因为它忽略了单元格中数据的格式。
- 使用
.Value2而不是默认的 属性 (.Value) 因为.Value2只会处理所有格式数字（货币、会计、日期、科学等）作为双打。
假设我们有 10,000 行虚拟数据，如以下数据集：
我没有删除整行 "non-chr9" 数据，而是忽略了这些数据，并通过将所有 "chr9" 数据复制到数组中来仅考虑 "chr9" 数据。如何编写代码来实现这样的任务？首先，我们必须复制我们的数据以避免数据丢失，因为我们不能撤销在 运行ning VBA Excel.
之后恢复原始数据的所有更改看来你已经做好了所有需要的准备工作。现在，我们可以通过首先将我们需要的每个变量声明为适当类型的数据来开始编码。
Dim i As Long, j As Long, k As Long
Dim LastRow As Long, LastColumn As Long, LengthDataChr9 As Long
如果您不声明变量，您的代码将 运行 这些变量默认为 Variant 类型。虽然 Variant 非常有用，但它会使您的代码变慢。因此，请确保每个变量都以合理的类型声明。这是良好的编程习惯，而且速度要快得多。
接下来，我们确定将用于构造数组大小的所有变量。我们需要
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
LastRow和LastColumn是一行或一列中最后一个有数据的单元格的行号和列号。请记住，如果您未正确设置 LastRow 和 LastColumn 或未使用格式正确的数据 sheet，则它们可能无法为您提供所需的行号和列号。我所说的 "well-formatted data sheet" 是指工作sheet，数据从单元格 A1 开始，A 列中的行数和第 1 行中的列数必须等于所有数据的范围。也就是说，所有数据的范围大小必须等于LastRowxLastColumn.
我们还需要数组的长度来存储所有"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 因为我们使用动态数组。 VBA Excel 自动声明 数组默认为 Variant 类型，但它们还没有大小。接下来，我们使用语句
Data中
Data = Range("A1", Cells(LastRow, LastColumn)).Value2
我们使用.Value2来提高代码的性能（见上面的提速技巧第2点）。由于数据已经复制到数组 Data 我们可以清除工作 sheet 数据以便我们可以使用它来粘贴 DataChr9.
Rows("1:" & Rows.Count).ClearContents
要清除作品所有（所有内容、格式等）sheet，我们可以使用Sheets("Sheet1").Cells.Clear或Sheet1.Cells.Clear .接下来，我们希望代码使用 For ... Next 语句循环遍历第 3 列中的元素数组 Data，因为我们要查找的所需数据位于此处.如果找到数组Data的元素包含字符串"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 的所有元素粘贴回 worksheet，方法是在代码中添加以下行：
Range("A1", Cells(LengthDataChr9, LastColumn)) = DataChr9
然后你就完成了！ 耶，终于来了！
OK，让我们编译上面的所有行代码。我们得到
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 秒。