Dim first_row, last_row, i
first_row=ActiveSheet.UsedRange.Row
last_row=first_row + ActiveSheet.UsedRange.Rows.count – 1
For i=last_row To first_row Step -1 ‘倒序循环
If WorksheetFunction.CountA(Rows(i))=0 Then
Rows(i).Delete ‘删除行
End If
Next
End Sub
Dim first_col, last_col, i
first_col=ActiveSheet.UsedRange.Column
last_col=first_col + ActiveSheet.UsedRange.Columns.count – 1
For i=last_col To first_col Step -1 ‘倒序循环
If WorksheetFunction.CountA(Columns(i))=0 Then
Columns(i).Delete ‘删除列
End If
Next
End Sub
‘选中单列整列、单列部分都支持
Dim rng As Range, arr, first_row, last_row, first_col, i, j
‘——————–参数填写:arr,指定条件字符串数组;title_row,表头行数
‘要删除的字符串数组,空值为删除空单元格,可使用模式匹配
arr=Array(“*一”, “*三”, “*五”)
title_row=1 ‘表头行数,不执行删除
Set rng=Intersect(ActiveSheet.UsedRange, Selection) ‘intersect语句避免选择整列造成无用计算
If rng.Columns.count > 1 Then Debug.Print “仅支持单列”: Exit Sub ‘仅支持单列,多列则退出
first_row=WorksheetFunction.Max(title_row, rng.Row) ‘表头行与选中区域开始行号的大值
last_row=rng.Row + rng.Rows.count – 1 ‘选中区域结束行号
first_col=rng.Column ‘选中区域开始列号
If rng.Row=1 Then ‘选中单列整列
For i=last_row To title_row + 1 Step -1 ‘倒序循环
For Each j In arr
‘只要有一个符合,就删除
If Cells(i, first_col) Like j Then Rows(i).Delete
Next
Next
ElseIf rng.Row > 1 Then ‘选中单列部分
For i=last_row To first_row Step -1 ‘倒序循环
For Each j In arr
If Cells(i, first_col) Like j Then Rows(i).Delete
Next
Next
End If
End Sub
举例
A列选中运行sub3后得到C列效果
以上代码在删除数据量较大(几千行以上)的情况下速度较慢,参考《Excel·VBA按列拆分工作表、工作簿》采用先Union行再删除的方法可大幅提高速度。一般情况下数据量越大较原版代码提高速度越明显,经测试,删除10万行数据仅需1秒同时,因为是最后一起删除整行,无续考虑删除行后导致行号变化,故采用正序循环
‘选中单列整列、单列部分都支持
Dim rng As Range, del_rng As Range, arr, first_row&, last_row&, first_col&, i&, j
‘——————–参数填写:arr,指定条件字符串数组;title_row,表头行数
‘要删除的字符串数组,空值为删除空单元格,可使用模式匹配
arr=Array(“1”)
title_row=1 ‘表头行数,不执行删除
Set rng=Intersect(ActiveSheet.UsedRange, Selection) ‘intersect语句避免选择整列造成无用计算
If rng.Columns.Count > 1 Then Debug.Print “仅支持单列”: Exit Sub ‘仅支持单列,多列则退出
first_row=WorksheetFunction.Max(title_row, rng.row) ‘表头行与选中区域开始行号的大值
last_row=rng.row + rng.Rows.Count – 1 ‘选中区域结束行号
first_col=rng.column: tm=Timer ‘选中区域开始列号
If rng.row=1 Then ‘选中单列整列
For i=title_row + 1 To last_row
For Each j In arr
‘只要有一个符合,就删除
If CStr(Cells(i, first_col).Value) Like j Then
If del_rng Is Nothing Then
Set del_rng=Rows(i)
Else
Set del_rng=Union(del_rng, Rows(i))
End If
End If
Next
Next
ElseIf rng.row > 1 Then ‘选中单列部分
For i=first_row To last_row
For Each j In arr
If CStr(Cells(i, first_col).Value) Like j Then
If del_rng Is Nothing Then
Set del_rng=Rows(i)
Else
Set del_rng=Union(del_rng, Rows(i))
End If
End If
Next
Next
End If
If Not del_rng Is Nothing Then del_rng.Delete
Debug.Print “删除完成用时:” & Format(Timer – tm, “0.00”) ‘耗时
End Sub
‘选中单列整列、单列部分都支持
Dim rng As Range, arr, first_row, last_row, first_col, i, j, del_if As Boolean
‘——————–参数填写:arr,指定条件字符串数组;title_row,表头行数
‘要保留的字符串数组,空值为保留空单元格,可使用模式匹配
arr=Array(“*一”, “*三”, “*五”)
title_row=1 ‘表头行数,不执行删除
Set rng=Intersect(ActiveSheet.UsedRange, Selection) ‘intersect语句避免选择整列造成无用计算
If rng.Columns.count > 1 Then Debug.Print “仅支持单列”: Exit Sub ‘仅支持单列,多列则退出
first_row=WorksheetFunction.Max(title_row, rng.Row) ‘表头行与选中区域开始行号的大值
last_row=rng.Row + rng.Rows.count – 1 ‘选中区域结束行号
first_col=rng.Column ‘选中区域开始列号
If rng.Row=1 Then ‘选中单列整列
For i=last_row To title_row + 1 Step -1 ‘倒序循环
del_if=True ‘初始为删除
For Each j In arr
‘只要有一个符合,就不删除
If Cells(i, first_col) Like j Then del_if=False: Exit For
Next
‘都不符合,删除
If del_if Then Rows(i).Delete
Next
ElseIf rng.Row > 1 Then ‘选中单列部分
For i=last_row To first_row Step -1 ‘倒序循环
del_if=True ‘初始为删除
For Each j In arr
If Cells(i, first_col) Like j Then del_if=False: Exit For
Next
If del_if Then Rows(i).Delete
Next
End If
End Sub
举例
A列选中运行sub4后得到C列效果
对于选中多行多列区域,在一行中所有列的内容都重复,则删除该行,仅保留唯一一行,注意区分字母大小写
‘适用单/多列选中、单/多列部分选中,去重删除整行
Dim rng As Range, dict As Object, first_row, last_row, first_col, last_col, i, j, res
Set rng=Intersect(ActiveSheet.UsedRange, Selection) ‘intersect语句避免选择整列造成无用计算
first_row=rng.Row ‘选中区域开始行号
last_row=first_row + rng.Rows.count – 1 ‘选中区域结束行号
first_col=rng.Column ‘选中区域开始列号
last_col=first_col + rng.Columns.count – 1 ‘选中区域结束列号
Set dict=CreateObject(“scripting.dictionary”)
For i=last_row To first_row Step -1 ‘倒序循环,避免遗漏
res=””
For j=first_col To last_col
res=res & CStr(Cells(i, j).Value)
Next
If Not dict.Exists(res) Then ‘字典键不存在,新增
dict(res)=””
Else
Rows(i).Delete ‘删除行
End If
Next
End Sub
举例
多列去重前
选中A-D列,运行sub5,获得结果
到此这篇关于Excel VBA指定条件删除整行整列的实现的文章就介绍到这了,更多相关Excel VBA指定条件删除内容请搜索脚本之家以前的文章或继续浏览下面的相关文章希望大家以后多多支持脚本之家!