如何用VBA代码快速删除有规律的多行数据？

楼主
kevinchengcw

Q: 如何用VBA代码快速删除有规律的多行数据？
A: 当一个工作表有几万行数据的时候，想要快速删除每隔某几行的几行，如每隔六行的六行，应用VBA代码可以超快速的完成该工作，我们先来说一下代码，以下代码用两种方式来处理，效果基本一致，代码如下：

Sub test() '常规处理方式代码
Dim M, N, I As Long
Dim mTimer
M = 30004 '设定行标最大值
MsgBox "本工作簿共有数据" & M & "行，按确定后开始每隔六行删除六行", vbOKOnly, "提示"
mTimer = Timer '储存计时开始时间
Application.ScreenUpdating = False '为了提速关闭屏幕刷新
Application.EnableEvents = False '为了提速关闭事件响应
Columns(1).Insert shift:=xlToRight '先在A列插入一个辅助列
For N = 5 To M Step 12 '设定循环，每次步进12
Range(Cells(N + 6, 1), Cells(N + 11, 1)) = 1 'A列当前行向下数第七行到第十二行的值等于1
Next N
[a5:au30005].Sort [a5] '将A5到AU30005单元格区域排序，以A5为排序依据（如不加此句，本例的运行时间会达到十倍以上）
Columns(1).SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete '选定A列有常量的值的行并删除（因要删除的行已经写入了1，通过排序又集中在了一起）
Columns(1).Delete '删除辅助列
Application.EnableEvents = True '打开事件响应
Application.ScreenUpdating = True '打开屏幕刷新
MsgBox "共用时： " & Format(Timer - mTimer, "0.000") & "秒" '显示所耗时间对话框
End Sub

Sub test2() '字典处理方式代码
Dim M, N, I As Long
Dim mTimer
Dim Dic
M = 30004 '设定行标最大值
Set Dic = CreateObject("scripting.dictionary") '创建字典
MsgBox "本工作簿共有数据" & M & "行，按确定后开始每隔六行删除六行", vbOKOnly, "提示"
mTimer = Timer '储存计时开始时间
Application.ScreenUpdating = False '为了提速关闭屏幕刷新
Application.EnableEvents = False '为了提速关闭事件响应
Columns(1).Insert shift:=xlToRight '先在A列插入一个辅助列
For N = 5 To M '设定循环，每次步进12
If Int((N - 5) / 6) Mod 2 = 0 Then '如果行数减5并除以6的整数值为偶数，即不需要删除的行
Dic.Add N, "" '添加字典项，key为行数值，item值为空
Else
Dic.Add N, 1 '如果行数减5并除以6的整数值为奇数，则添加字典项，key为行数值，item值为1
End If
Next N
Range(Cells(5, 1), Cells(M, 1)) = WorksheetFunction.Transpose(Dic.Items) '将字典的items集合内容写入到对应的单元格区域
[a5:au30005].Sort [a5] '将A5到AU30005单元格区域排序，以A5为排序依据（如不加此句，本例的运行时间会达到十倍以上）
Columns(1).SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete '选定A列有常量的值的行并删除（因要删除的行已经写入了1，通过排序又集中在了一起）
Columns(1).Delete '删除辅助列
Application.EnableEvents = True '打开事件响应
Application.ScreenUpdating = True '打开屏幕刷新
MsgBox "共用时： " & Format(Timer - mTimer, "0.000") & "秒" '显示所耗时间对话框
End Sub

从以上代码中可以看出，当删除的行存在于多个区域中不连续时，如果能通过辅助列将其集中，则在行数值相当大时的提速作用相当明显。

以上代码亦可改编成删除列。

附示例文件。

每隔六行删除六行.rar

2楼
hyx1976

这对于一个新手来说比较难啊！